Theory More_Transcendental

(* ---------------------------------------------------------------------------- *)
section ‹Introduction›
(* ---------------------------------------------------------------------------- *)

text ‹The complex plane or some of its parts (e.g., the unit disc or the upper half plane) are often
taken as the domain in which models of various geometries (both Euclidean and non-Euclidean ones)
are formalized. The complex plane gives simpler and more compact formulas than the Cartesian plane.
Within complex plane is easier to describe geometric objects and perform the calculations (usually
shedding some new light on the subject). We give a formalization of the extended complex
plane (given both as a complex projective space and as the Riemann sphere), its objects (points,
circles and lines), and its transformations (Möbius transformations).›

(* ---------------------------------------------------------------------------- *)
section ‹Related work›
(* ---------------------------------------------------------------------------- *)

text‹During the last decade, there have been many results in formalizing
geometry in proof-assistants. Parts of Hilbert’s seminal book
,,Foundations of Geometry'' \cite{hilbert} have been formalized both
in Coq and Isabelle/Isar.  Formalization of first two groups of axioms
in Coq, in an intuitionistic setting was done by Dehlinger et
al. \cite{hilbert-coq}. First formalization in Isabelle/HOL was done
by Fleuriot and Meikele \cite{hilbert-isabelle}, and some further
developments were made in master thesis of Scott \cite{hilbert-scott}.
Large fragments of Tarski's geometry \cite{tarski} have been
formalized in Coq by Narboux et al. \cite{narboux-tarski}. Within Coq,
there are also formalizations of von Plato’s constructive geometry by
Kahn \cite{vonPlato,von-plato-formalization}, French high school
geometry by Guilhot \cite{guilhot} and ruler and compass geometry by
Duprat \cite{duprat2008}, etc.

In our previous work \cite{petrovic2012formalizing}, we have already
formally investigated a Cartesian model of Euclidean geometry. 
›

(* ---------------------------------------------------------------------------- *)
section ‹Background theories› 
(* ---------------------------------------------------------------------------- *)

text ‹In this section we introduce some basic mathematical notions and prove some lemmas needed in the rest of our
formalization. We describe:

     trigonometric functions,

     complex numbers, 

     systems of two and three linear equations with two unknowns (over arbitrary fields), 

     quadratic equations (over real and complex numbers), systems of quadratic and real
      equations, and systems of two quadratic equations,

     two-dimensional vectors and matrices over complex numbers.
›

(* -------------------------------------------------------------------------- *)
subsection ‹Library Additions for Trigonometric Functions›
(* -------------------------------------------------------------------------- *)

theory More_Transcendental
  imports Complex_Main "HOL-Library.Periodic_Fun"
begin

text ‹Additional properties of @{term sin} and @{term cos} functions that are later used in proving
conjectures for argument of complex number.›

text ‹Sign of trigonometric functions on some characteristic intervals.›

lemma cos_lt_zero_on_pi2_pi [simp]:
  assumes "x > pi/2" and "x  pi"
  shows "cos x < 0"
  using cos_gt_zero_pi[of "pi - x"] assms
  by simp

text ‹Value of trigonometric functions in points $k\pi$ and $\frac{\pi}{2} + k\pi$.›

lemma sin_kpi [simp]:
  fixes k::int
  shows "sin (k * pi) = 0"
  by (simp add: sin_zero_iff_int2)

lemma cos_odd_kpi [simp]:
  fixes k::int
  assumes "odd k"
  shows "cos (k * pi) = -1"
  by (simp add: assms mult.commute)

lemma cos_even_kpi [simp]:
  fixes k::int
  assumes "even k"
  shows "cos (k * pi) = 1"
  by (simp add: assms mult.commute)

lemma sin_pi2_plus_odd_kpi [simp]:
  fixes k::int
  assumes "odd k"
  shows "sin (pi / 2 + k * pi) = -1"
  using assms
  by (simp add: sin_add)

lemma sin_pi2_plus_even_kpi [simp]:
  fixes k::int
  assumes "even k"
  shows "sin (pi / 2 + k * pi) = 1"
  using assms
  by (simp add: sin_add)

text ‹Solving trigonometric equations and systems with special values (0, 1, or -1) of sine and cosine functions›

lemma cos_0_iff_canon:
  assumes "cos φ = 0" and "-pi < φ" and "φ  pi"
  shows "φ = pi/2  φ = -pi/2"
  by (smt (verit, best) arccos_0 arccos_cos assms cos_minus divide_minus_left)

lemma sin_0_iff_canon:
  assumes "sin φ = 0" and "-pi < φ" and "φ  pi"
  shows "φ = 0  φ = pi"
  using assms sin_eq_0_pi by force

lemma cos0_sin1:
  assumes "sin φ = 1"
  shows " k::int. φ = pi/2 + 2*k*pi"
  by (smt (verit, ccfv_threshold) assms cos_diff cos_one_2pi_int cos_pi_half mult_cancel_right1 sin_pi_half sin_plus_pi)

(* TODO: add lemmas for cos = -1, sin = 0 and cos = 0, sin = -1 *)


text ‹Sine is injective on $[-\frac{\pi}{2}, \frac{\pi}{2}]$›

lemma sin_inj:
  assumes "-pi/2  α  α  pi/2" and "-pi/2  α'  α'  pi/2"
  assumes "α  α'"
  shows "sin α  sin α'"
  by (metis assms divide_minus_left sin_inj_pi)

text ‹Periodicity of trigonometric functions›

text ‹The following are available in HOL-Decision\_Procs.Approximation\_Bounds, but we want to avoid
that dependency›

lemma sin_periodic_nat [simp]: 
  fixes n :: nat
  shows "sin (x + n * (2 * pi)) = sin x"
  by (metis (no_types, hide_lams) add.commute add.left_neutral cos_2npi cos_one_2pi_int mult.assoc mult.commute mult.left_neutral mult_zero_left sin_add sin_int_2pin)

lemma sin_periodic_int [simp]:
  fixes i :: int
  shows "sin (x + i * (2 * pi)) = sin x"
  by (metis add.right_neutral cos_int_2pin mult.commute mult.right_neutral mult_zero_right sin_add sin_int_2pin)

lemma cos_periodic_nat [simp]: 
  fixes n :: nat
  shows "cos (x + n * (2 * pi)) = cos x"
  by (metis add.left_neutral cos_2npi cos_add cos_periodic mult.assoc mult_2 mult_2_right of_nat_numeral sin_periodic sin_periodic_nat)

lemma cos_periodic_int [simp]:
  fixes i :: int
  shows "cos (x + i * (2 * pi)) = cos x"
  by (metis cos_add cos_int_2pin diff_zero mult.commute mult.right_neutral mult_zero_right sin_int_2pin)

text ‹Values of both sine and cosine are repeated only after multiples of $2\cdot \pi$›

lemma sin_cos_eq:
  fixes a b :: real
  assumes "cos a = cos b" and "sin a = sin b"
  shows " k::int. a - b = 2*k*pi"
  by (metis assms cos_diff cos_one_2pi_int mult.commute sin_cos_squared_add3)

text ‹The following two lemmas are consequences of surjectivity of cosine for the range $[-1, 1]$.›

lemma ex_cos_eq:
  assumes "-pi/2  α  α  pi/2"
  assumes "a  0" and "a < 1"
  shows " α'. -pi/2  α'  α'  pi/2  α'  α  cos (α - α') = a"
proof-
  have "arccos a > 0" "arccos a  pi/2"
    using a  0 a < 1
    using arccos_lt_bounded arccos_le_pi2
    by auto

  show ?thesis
  proof (cases "α - arccos a  - pi/2")
    case True
    thus ?thesis
      using assms ‹arccos a > 0 ‹arccos a  pi/2
      by (rule_tac x = "α - arccos a" in exI) auto
  next
    case False
    thus ?thesis
      using assms ‹arccos a > 0 ‹arccos a  pi/2
      by (rule_tac x = "α + arccos a" in exI) auto
  qed
qed

lemma ex_cos_gt:
  assumes "-pi/2  α  α  pi/2"
  assumes "a < 1"
  shows " α'. -pi/2  α'  α'  pi/2  α'  α  cos (α - α') > a"
proof-
  obtain a' where "a'  0" "a' > a" "a' < 1"
    by (metis assms(2) dense_le_bounded linear not_one_le_zero)
  thus ?thesis
    using ex_cos_eq[of α a'] assms
    by auto
qed

text ‹The function @{term atan2} is a generalization of @{term arctan} that takes a pair of coordinates
of non-zero points returns its angle in the range $[-\pi, \pi)$.›

definition atan2 where
  "atan2 y x =
    (if x > 0 then arctan (y/x)
     else if x < 0 then
          if y > 0 then arctan (y/x) + pi else arctan (y/x) - pi
     else
          if y > 0 then pi/2 else if y < 0 then -pi/2 else 0)"

lemma atan2_bounded: 
  shows "-pi  atan2 y x  atan2 y x < pi"
  using arctan_bounded[of "y/x"] zero_le_arctan_iff[of "y/x"] arctan_le_zero_iff[of "y/x"] zero_less_arctan_iff[of "y/x"] arctan_less_zero_iff[of "y/x"]
  using divide_neg_neg[of y x] divide_neg_pos[of y x] divide_pos_pos[of y x]  divide_pos_neg[of y x]
  unfolding atan2_def
  by (simp (no_asm_simp)) auto

end

Theory Canonical_Angle

(* -------------------------------------------------------------------------- *)
subsection ‹Canonical angle› 
(* -------------------------------------------------------------------------- *)

text ‹Canonize any angle to $(-\pi, \pi]$ (taking account of $2\pi$ periodicity of @{term sin} and
@{term cos}). With this function, for example, multiplicative properties of @{term arg} for complex
numbers can easily be expressed and proved.›

theory Canonical_Angle
imports More_Transcendental
begin


abbreviation canon_ang_P where
 "canon_ang_P α α'  (-pi < α'  α'  pi)  ( k::int. α - α' = 2*k*pi)"

definition canon_ang :: "real  real" ("_") where
  "α = (THE α'. canon_ang_P α α')"

text ‹There is a canonical angle for every angle.›
lemma canon_ang_ex:
  shows " α'. canon_ang_P α α'"
proof-
  have ***: " α::real.  α'. 0 < α'  α'  1  ( k::int. α' = α - k)"
  proof
    fix α::real
    show "α'>0. α'  1  (k::int. α' = α - k)"
    proof (cases "α = floor α")
      case True
      thus ?thesis
        by (rule_tac x="α - floor α + 1" in exI, auto) (rule_tac x="floor α - 1" in exI, auto)
    next
      case False
      thus ?thesis
        using real_of_int_floor_ge_diff_one[of "α"]
        using of_int_floor_le[of "α"]
        by (rule_tac x="α - floor α" in exI) smt
    qed
  qed

  have **: " α::real.  α'. 0 < α'  α'  2  ( k::int. α - α' = 2*k - 1)"
  proof
    fix α::real
    from ***[rule_format, of "(α + 1) /2"]
    obtain α' and k::int where "0 < α'" "α'  1" "α' = (α + 1)/2 - k"
      by force
    hence "0 < α'" "α'  1" "α' = α/2 - k + 1/2"
      by auto
    thus "α'>0. α'  2  (k::int. α - α' = real_of_int (2 * k - 1))"
      by (rule_tac x="2*α'" in exI) auto
  qed
  have *: " α::real.  α'. -1 < α'  α'  1  ( k::int. α - α' = 2*k)"
  proof
    fix α::real
    from ** obtain α' and k :: int where
      "0 < α'  α'  2  α - α' = 2*k - 1"
      by force
    thus "α'>-1. α'  1  (k. α - α' = real_of_int (2 * (k::int)))"
      by (rule_tac x="α' - 1" in exI) (auto simp add: field_simps)
  qed
  obtain α' k where 1: "α' >- 1  α'  1" and 2: "α / pi - α' = real_of_int (2 * k)"
    using *[rule_format, of "α / pi"]
    by auto
  have "α'*pi > -pi  α'*pi  pi" 
    using 1
    by (smt mult.commute mult_le_cancel_left1 mult_minus_right pi_gt_zero)
  moreover
  have "α - α'*pi = 2 * real_of_int k * pi"
    using 2
    by (auto simp add: field_simps)
  ultimately
  show ?thesis
    by auto
qed

text ‹Canonical angle of any angle is unique.›
lemma canon_ang_unique:
  assumes "canon_ang_P α α1" and "canon_ang_P α α2"
  shows "α1 = α2"
proof-
  obtain k1::int where "α - α1 = 2*k1*pi"
    using assms(1)
    by auto
  obtain k2::int where "α - α2 = 2*k2*pi"
    using assms(2)
    by auto
  hence *: "-α1 + α2 = 2*(k1 - k2)*pi"
    using α - α1 = 2*k1*pi›
    by (simp add:field_simps)
  moreover
  have "-α1 + α2 < 2 * pi" "-α1 + α2 > -2*pi"
    using assms
    by auto
  ultimately
  have "-α1 + α2 = 0"
    using mult_less_cancel_right[of "-2" pi "real_of_int(2 * (k1 - k2))"]
    by auto
  thus ?thesis
    by auto
qed

text ‹Canonical angle is always in $(-\pi, \pi]$ and differs from the starting angle by $2k\pi$.›
lemma canon_ang:
  shows "-pi < α" and "α  pi" and " k::int. α - α = 2*k*pi"
proof-
  obtain α' where "canon_ang_P α α'"
    using canon_ang_ex[of α]
    by auto
  have "canon_ang_P α α"
    unfolding canon_ang_def
  proof (rule theI[where a="α'"])
    show "canon_ang_P α α'"
      by fact
  next
    fix α''
    assume "canon_ang_P α α''"
    thus "α'' = α'"
      using ‹canon_ang_P α α'
      using canon_ang_unique[of α' α α'']
      by simp
  qed
  thus "-pi < α" "α  pi" " k::int. α - α = 2*k*pi"
    by auto
qed

text ‹Angles in $(-\pi, \pi]$ are already canonical.›
lemma canon_ang_id:
  assumes  "-pi < α  α  pi"
  shows "α = α"
  using assms
  using canon_ang_unique[of "canon_ang α" α α] canon_ang[of α]
  by auto

text ‹Angles that differ by $2k\pi$ have equal canonical angles.›
lemma canon_ang_eq:
  assumes " k::int. α1 - α2 = 2*k*pi"
  shows "α1 = α2"
proof-
  obtain k'::int where *: "- pi < α1" "α1  pi" "α1 - α1 = 2 * k' * pi"
    using canon_ang[of α1]
    by auto

  obtain k''::int where **: "- pi < α2" "α2  pi" "α2 - α2 = 2 * k'' * pi"
    using canon_ang[of α2]
    by auto

  obtain k::int where ***: "α1 - α2 = 2*k*pi"
    using assms
    by auto

  have "m::int. α1 - α2 = 2 * m * pi"
    using **(3) ***
    by (rule_tac x="k+k''" in exI) (auto simp add: field_simps)

  thus ?thesis
    using canon_ang_unique[of "α1" α1 "α2"] * **
    by auto
qed

text ‹Introduction and elimination rules›
lemma canon_ang_eqI:
  assumes "k::int. α' - α = 2 * k * pi" and "- pi < α'  α'  pi"
  shows "α = α'"
  using assms
  using canon_ang_eq[of α' α]
  using canon_ang_id[of α']
  by auto

lemma canon_ang_eqE:
  assumes "α1 = α2"
  shows " (k::int). α1 - α2 = 2 *k * pi"
proof-
  obtain k1 k2 :: int where
    "α1 - α1 = 2 * k1 * pi"
    "α2 - α2 = 2 * k2 * pi"
    using canon_ang[of α1] canon_ang[of α2]
    by auto
  thus ?thesis
    using assms
    by (rule_tac x="k1 - k2" in exI) (auto simp add: field_simps)
qed

text ‹Canonical angle of opposite angle›

lemma canon_ang_uminus:
  assumes "α  pi"
  shows "-α = -α"
proof (rule canon_ang_eqI)
  show "x::int. - α - - α = 2 * x * pi"
    using canon_ang(3)[of α]
    by (metis minus_diff_eq minus_diff_minus)
next
  show "- pi < - α  - α  pi"
    using canon_ang(1)[of α] canon_ang(2)[of α] assms
    by auto
qed

lemma canon_ang_uminus_pi:
  assumes "α = pi"
  shows "-α = α"
proof (rule canon_ang_eqI)
  obtain k::int where "α - α = 2 * k * pi"
    using canon_ang(3)[of α]
    by auto
  thus "x::int. α - - α = 2 * x * pi"
    using assms
    by (rule_tac x="k+(1::int)" in exI) (auto simp add: field_simps)
next
  show "- pi < α  α  pi"
    using assms
    by auto
qed

text ‹Canonical angle of difference of two angles›
lemma canon_ang_diff:
  shows "α - β = α - β"
proof (rule canon_ang_eq)
  show "x::int. α - β - (α - β) = 2 * x * pi"
  proof-
    obtain k1::int where "α - α = 2*k1*pi"
      using canon_ang(3)
      by auto
    moreover
    obtain k2::int where "β - β = 2*k2*pi"
      using canon_ang(3)
      by auto
    ultimately
    show ?thesis
      by (rule_tac x="k1 - k2" in exI) (auto simp add: field_simps)
  qed
qed

text ‹Canonical angle of sum of two angles›
lemma canon_ang_sum:
  shows "α + β = α + β"
proof (rule canon_ang_eq)
  show "x::int. α + β - (α + β) = 2 * x * pi"
  proof-
    obtain k1::int where "α - α = 2*k1*pi"
      using canon_ang(3)
      by auto
    moreover
    obtain k2::int where "β - β = 2*k2*pi"
      using canon_ang(3)
      by auto
    ultimately
    show ?thesis
      by (rule_tac x="k1 + k2" in exI) (auto simp add: field_simps)
  qed
qed

text ‹Canonical angle of angle from $(0, 2\pi]$ shifted by $\pi$›

lemma canon_ang_plus_pi1:
  assumes "0 < α" and "α  2*pi"
  shows "α + pi = α - pi"
proof (rule canon_ang_eqI)
  show " x::int. α - pi - (α + pi) = 2 * x * pi"
    by (rule_tac x="-1" in exI) auto
next
  show "- pi < α - pi  α - pi  pi"
    using assms
    by auto
qed

lemma canon_ang_minus_pi1:
  assumes "0 < α" and "α  2*pi"
  shows "α - pi = α - pi"
proof (rule canon_ang_id)
  show "- pi < α - pi  α - pi  pi"
    using assms
    by auto
qed

text ‹Canonical angle of angles from $(-2\pi, 0]$ shifted by $\pi$›

lemma canon_ang_plus_pi2:
  assumes "-2*pi < α" and "α  0"
  shows "α + pi = α + pi"
proof (rule canon_ang_id)
  show "- pi < α + pi  α + pi  pi"
    using assms
    by auto
qed

lemma canon_ang_minus_pi2:
  assumes "-2*pi < α" and "α  0"
  shows "α - pi = α + pi"
proof (rule canon_ang_eqI)
  show " x::int. α + pi - (α - pi) = 2 * x * pi"
    by (rule_tac x="1" in exI) auto
next
  show "- pi < α + pi  α + pi  pi"
    using assms
    by auto
qed

text ‹Canonical angle of angle in $(\pi, 3\pi]$.›
lemma canon_ang_pi_3pi: 
  assumes "pi < α" and "α  3 * pi"
  shows "α = α - 2*pi"
proof-
  have "x. - pi = pi * real_of_int x"
    by (rule_tac x="-1" in exI, simp)
  thus ?thesis
    using assms canon_ang_eqI[of "α - 2*pi" "α"]
    by auto
qed

text ‹Canonical angle of angle in $(-3\pi, -\pi]$.›
lemma canon_ang_minus_3pi_minus_pi: 
  assumes "-3*pi < α" and "α  -pi"
  shows "α = α + 2*pi"
proof-
  have "x. pi = pi * real_of_int x"
    by (rule_tac x="1" in exI, simp)
  thus ?thesis
    using assms canon_ang_eqI[of "α + 2*pi" "α"]
    by auto
qed

text ‹Canonical angles for some special angles›

lemma zero_canonical [simp]:
  shows "0 = 0"
  using canon_ang_eqI[of 0 0]
  by simp

lemma pi_canonical [simp]:
  shows "pi = pi"
  by (simp add: canon_ang_id)

lemma two_pi_canonical [simp]:
  shows "2 * pi = 0"
  using canon_ang_plus_pi1[of "pi"]
  by simp

text ‹Canonization preserves sine and cosine›
lemma canon_ang_sin [simp]:
  shows "sin α = sin α"
proof-
  obtain x::int where "α = α + pi * (x * 2)"
    using canon_ang(3)[of α]
    by (auto simp add: field_simps)
  thus ?thesis
    using sin_periodic_int[of "α" x]
    by (simp add: field_simps)
qed

lemma canon_ang_cos [simp]:
  shows "cos α = cos α"
proof-
  obtain x::int where "α = α + pi * (x * 2)"
    using canon_ang(3)[of α]
    by (auto simp add: field_simps)
  thus ?thesis
    using cos_periodic_int[of "α" x]
    by (simp add: field_simps)
qed

end

Theory More_Complex

(* -------------------------------------------------------------------------- *)
subsection ‹Library Additions for Complex Numbers›
(* -------------------------------------------------------------------------- *)

text ‹Some additional lemmas about complex numbers.›

theory More_Complex
  imports Complex_Main More_Transcendental Canonical_Angle
begin

text ‹Conjugation and @{term cis}
          
declare cis_cnj[simp] 

lemma rcis_cnj: 
  shows "cnj a = rcis (cmod a) (- arg a)"
  by (subst rcis_cmod_arg[of a, symmetric]) (simp add: rcis_def)

lemmas complex_cnj = complex_cnj_diff complex_cnj_mult complex_cnj_add complex_cnj_divide complex_cnj_minus

text ‹Some properties for @{term complex_of_real}. Also, since it is often used in our
formalization we abbreviate it to @{term cor}.›

abbreviation cor :: "real  complex" where
  "cor  complex_of_real"

lemma cmod_cis [simp]:
  assumes "a  0"
  shows "cor (cmod a) * cis (arg a) = a"
  using assms
  by (metis rcis_cmod_arg rcis_def)

lemma cis_cmod [simp]:
  assumes "a  0"
  shows "cis (arg a) * cor (cmod a) = a"
  using assms cmod_cis[of a]
  by (simp add: field_simps)

lemma cor_squared:
  shows "(cor x)2 = cor (x2)"
  by (simp add: power2_eq_square)

lemma cor_sqrt_mult_cor_sqrt [simp]:
  shows "cor (sqrt A) * cor (sqrt A) = cor ¦A¦"
  by (metis of_real_mult real_sqrt_mult_self)

lemma cor_eq_0: "cor x + 𝗂 * cor y = 0  x = 0  y = 0"
 by (metis Complex_eq Im_complex_of_real Im_i_times Re_complex_of_real add_cancel_left_left of_real_eq_0_iff plus_complex.sel(2) zero_complex.code)

lemma one_plus_square_neq_zero [simp]:
  shows "1 + (cor x)2  0"
  by (metis (hide_lams, no_types) of_real_1 of_real_add of_real_eq_0_iff of_real_power power_one sum_power2_eq_zero_iff zero_neq_one)

text ‹Additional lemmas about @{term Complex} constructor. Following newer versions of Isabelle,
these should be deprecated.›

lemma complex_real_two [simp]:
  shows "Complex 2 0 = 2"
  by (simp add: Complex_eq)

lemma complex_double [simp]:
  shows "(Complex a b) * 2 = Complex (2*a) (2*b)"
  by (simp add: Complex_eq)

lemma complex_half [simp]: 
  shows "(Complex a b) / 2 = Complex (a/2) (b/2)"
  by (subst complex_eq_iff) auto

lemma Complex_scale1:
  shows "Complex (a * b) (a * c) = cor a * Complex b c"
  unfolding complex_of_real_def
  unfolding Complex_eq
  by (auto simp add: field_simps)

lemma Complex_scale2: 
  shows "Complex (a * c) (b * c) = Complex a b * cor c"
  unfolding complex_of_real_def
  unfolding Complex_eq
  by (auto simp add: field_simps)

lemma Complex_scale3: 
  shows "Complex (a / b) (a / c) = cor a * Complex (1 / b) (1 / c)"
  unfolding complex_of_real_def
  unfolding Complex_eq
  by (auto simp add: field_simps)

lemma Complex_scale4:
  shows "c  0  Complex (a / c) (b / c) = Complex a b / cor c"
  unfolding complex_of_real_def
  unfolding Complex_eq
  by (auto simp add: field_simps power2_eq_square)

lemma Complex_Re_express_cnj:
  shows "Complex (Re z) 0 = (z + cnj z) / 2"
  by (cases z) (simp add: Complex_eq)

lemma Complex_Im_express_cnj:
  shows "Complex 0 (Im z) = (z - cnj z)/2"
  by (cases z) (simp add: Complex_eq)

text ‹Additional properties of @{term cmod}.›

lemma complex_mult_cnj_cmod:
  shows "z * cnj z = cor ((cmod z)2)"
  using complex_norm_square
  by auto

lemma cmod_square: 
  shows "(cmod z)2 = Re (z * cnj z)"
  using complex_mult_cnj_cmod[of z]
  by (simp add: power2_eq_square)

lemma cor_cmod_power_4 [simp]:
  shows "cor (cmod z) ^ 4 = (z * cnj z)2"
  by (simp add: complex_mult_cnj_cmod)

lemma cnjE:
  assumes "x  0"
  shows "cnj x = cor ((cmod x)2) / x"
  using complex_mult_cnj_cmod[of x] assms
  by (auto simp add: field_simps)

lemma cmod_cor_divide [simp]:
  shows "cmod (z / cor k) = cmod z / ¦k¦"
  by (simp add: norm_divide)

lemma cmod_mult_minus_left_distrib [simp]:
  shows "cmod (z*z1 - z*z2) = cmod z * cmod(z1 - z2)"
  by (metis norm_mult right_diff_distrib)

lemma cmod_eqI:
  assumes "z1 * cnj z1 = z2 * cnj z2"
  shows "cmod z1 = cmod z2"
  using assms
  by (subst complex_mod_sqrt_Re_mult_cnj)+ auto

lemma cmod_eqE:
  assumes "cmod z1 = cmod z2"
  shows "z1 * cnj z1 = z2 * cnj z2"
  by (simp add: assms complex_mult_cnj_cmod)

lemma cmod_eq_one [simp]:
  shows "cmod a = 1  a*cnj a = 1"
  by (metis cmod_eqE cmod_eqI complex_cnj_one monoid_mult_class.mult.left_neutral norm_one)

text ‹We introduce @{term is_real} (the imaginary part of complex number is zero) and @{term is_imag}
(real part of complex number is zero) operators and prove some of their properties.›

abbreviation is_real where
  "is_real z  Im z = 0"

abbreviation is_imag where
  "is_imag z  Re z = 0"

lemma real_imag_0:
  assumes "is_real a" "is_imag a" 
  shows "a = 0"
  using assms
  by (simp add: complex.expand)

lemma complex_eq_if_Re_eq:
  assumes "is_real z1" and "is_real z2"
  shows "z1 = z2  Re z1 = Re z2"
  using assms
  by (cases z1, cases z2) auto

lemma mult_reals [simp]:
  assumes "is_real a" and "is_real b"
  shows "is_real (a * b)"
  using assms
  by auto

lemma div_reals [simp]:
  assumes "is_real a" and "is_real b"
  shows "is_real (a / b)"
  using assms
  by (simp add: complex_is_Real_iff)

lemma complex_of_real_Re [simp]:
  assumes "is_real k"
  shows "cor (Re k) = k"
  using assms
  by (cases k) (auto simp add: complex_of_real_def)

lemma cor_cmod_real:
  assumes "is_real a"
  shows "cor (cmod a) = a  cor (cmod a) = -a"
  using assms
  unfolding cmod_def
  by (cases "Re a > 0") auto

lemma eq_cnj_iff_real:
  shows "cnj z = z  is_real z"
  by (cases z) (simp add: Complex_eq)

lemma eq_minus_cnj_iff_imag:
  shows "cnj z = -z  is_imag z"
  by (cases z) (simp add: Complex_eq)

lemma Re_divide_real:
  assumes "is_real b" and "b  0"
  shows "Re (a / b) = (Re a) / (Re b)"
  using assms
  by (simp add: complex_is_Real_iff)

lemma Re_mult_real:
  assumes "is_real a"
  shows "Re (a * b) = (Re a) * (Re b)"
  using assms
  by simp

lemma Im_mult_real:
  assumes "is_real a"
  shows "Im (a * b) = (Re a) * (Im b)"
  using assms
  by simp

lemma Im_divide_real:
  assumes "is_real b" and "b  0"
  shows "Im (a / b) = (Im a) / (Re b)"
  using assms
  by (simp add: complex_is_Real_iff)

lemma Re_sgn:
  assumes "is_real R"
  shows "Re (sgn R) = sgn (Re R)"
  using assms
  by (metis Re_sgn complex_of_real_Re norm_of_real real_sgn_eq)

lemma is_real_div:
  assumes "b  0"
  shows "is_real (a / b)  a*cnj b = b*cnj a"
  using assms
  by (metis complex_cnj_divide complex_cnj_zero_iff eq_cnj_iff_real frac_eq_eq mult.commute)

lemma is_real_mult_real:
  assumes "is_real a" and "a  0"
  shows "is_real b  is_real (a * b)"
  using assms
  by (cases a, auto simp add: Complex_eq)

lemma Im_express_cnj:
  shows "Im z = (z - cnj z) / (2 * 𝗂)"
  by (simp add: complex_diff_cnj field_simps)

lemma Re_express_cnj: 
  shows "Re z = (z + cnj z) / 2"
  by (simp add: complex_add_cnj)

text ‹Rotation of complex number for 90 degrees in the positive direction.›

abbreviation rot90 where
  "rot90 z  Complex (-Im z) (Re z)"

lemma rot90_ii: 
  shows "rot90 z = z * 𝗂"
  by (metis Complex_mult_i complex_surj)

text ‹With @{term cnj_mix} we introduce scalar product between complex vectors. This operation shows
to be useful to succinctly express some conditions.›

abbreviation cnj_mix where
  "cnj_mix z1 z2  cnj z1 * z2 + z1 * cnj z2"

abbreviation scalprod where
  "scalprod z1 z2  cnj_mix z1 z2 / 2"

lemma cnj_mix_minus:
  shows "cnj z1*z2 - z1*cnj z2 = 𝗂 * cnj_mix (rot90 z1) z2"
  by (cases z1, cases z2) (simp add: Complex_eq field_simps)

lemma cnj_mix_minus':
  shows "cnj z1*z2 - z1*cnj z2 = rot90 (cnj_mix (rot90 z1) z2)"
  by (cases z1, cases z2) (simp add: Complex_eq field_simps)

lemma cnj_mix_real [simp]:
  shows "is_real (cnj_mix z1 z2)"
  by (cases z1, cases z2) simp

lemma scalprod_real [simp]:
  shows "is_real (scalprod z1 z2)"
  using cnj_mix_real
  by simp

text ‹Additional properties of @{term cis} function.›

lemma cis_minus_pi2 [simp]:
  shows "cis (-pi/2) = -𝗂"
  by (simp add: cis_inverse[symmetric])

lemma cis_pi2_minus_x [simp]:
  shows "cis (pi/2 - x) = 𝗂 * cis(-x)"
  using cis_divide[of "pi/2" x, symmetric]
  using cis_divide[of 0 x, symmetric]
  by simp

lemma cis_pm_pi [simp]: 
  shows "cis (x - pi) = - cis x" and  "cis (x + pi) = - cis x"
  by (simp add: cis.ctr complex_minus)+


lemma cis_times_cis_opposite [simp]: 
  shows "cis φ * cis (- φ) = 1"
  by (simp add: cis_mult)

text @{term cis} repeats only after $2k\pi$›
lemma cis_eq:
  assumes "cis a = cis b"
  shows " k::int. a - b = 2 * k * pi"
  using assms sin_cos_eq[of a b]
  using cis.sel[of a] cis.sel[of b]
  by (cases "cis a", cases "cis b") auto

text @{term cis} is injective on $(-\pi, \pi]$.›
lemma cis_inj:
  assumes "-pi < α" and "α  pi" and "-pi < α'" and "α'  pi"
  assumes "cis α = cis α'"
  shows "α = α'"
  using assms
  by (metis arg_unique sgn_cis)

text @{term cis} of an angle combined with @{term cis} of the opposite angle›

lemma cis_diff_cis_opposite [simp]: 
  shows "cis φ - cis (- φ) = 2 * 𝗂 * sin φ"
  using Im_express_cnj[of "cis φ"]
  by simp

lemma cis_opposite_diff_cis [simp]:
  shows "cis (-φ) - cis (φ) = - 2 * 𝗂 * sin φ"
  using cis_diff_cis_opposite[of "-φ"]
  by simp

lemma cis_add_cis_opposite [simp]: 
  shows "cis φ + cis (-φ) = 2 * cos φ"
  by (metis cis.sel(1) cis_cnj complex_add_cnj)

text @{term cis} equal to 1 or -1›
lemma cis_one [simp]:
  assumes "sin φ = 0" and "cos φ = 1"
  shows "cis φ = 1"
  using assms
  by (auto simp add: cis.ctr one_complex.code)

lemma cis_minus_one [simp]:
  assumes "sin φ = 0" and "cos φ = -1"
  shows "cis φ = -1"
  using assms
  by (auto simp add: cis.ctr Complex_eq_neg_1)

(* -------------------------------------------------------------------------- *)
subsubsection ‹Additional properties of complex number argument›
(* -------------------------------------------------------------------------- *)

text @{term arg} of real numbers›

lemma is_real_arg1:
  assumes "arg z = 0  arg z = pi"
  shows "is_real z"
  using assms
  using rcis_cmod_arg[of z] Im_rcis[of "cmod z" "arg z"]
  by auto

lemma is_real_arg2:
  assumes "is_real z"
  shows "arg z = 0  arg z = pi"
proof (cases "z = 0")
  case False
  thus ?thesis
    using arg_bounded[of z]
    by (smt (verit, best) Im_sgn assms cis.simps(2) cis_arg div_0 sin_zero_pi_iff)
qed (auto simp add: arg_zero)

lemma arg_complex_of_real_positive [simp]:
  assumes "k > 0"
  shows "arg (cor k) = 0"
proof-
  have "cos (arg (Complex k 0)) > 0"
    using assms
    using rcis_cmod_arg[of "Complex k 0"] Re_rcis[of "cmod (Complex k 0)" "arg (Complex k 0)"]
    using cmod_eq_Re by force
  thus ?thesis
    using assms is_real_arg2[of "cor k"]
    unfolding complex_of_real_def
    by auto
qed

lemma arg_complex_of_real_negative [simp]:
  assumes "k < 0"
  shows "arg (cor k) = pi"
proof-
  have "cos (arg (Complex k 0)) < 0"
    using k < 0 rcis_cmod_arg[of "Complex k 0"] Re_rcis[of "cmod (Complex k 0)" "arg (Complex k 0)"]
    by (metis complex.sel(1) mult_less_0_iff norm_not_less_zero)
  thus ?thesis
    using assms is_real_arg2[of "cor k"]
    unfolding complex_of_real_def
    by auto
qed

lemma arg_0_iff:
  shows "z  0  arg z = 0  is_real z  Re z > 0"
  by (smt arg_complex_of_real_negative arg_complex_of_real_positive arg_zero complex_of_real_Re is_real_arg1 pi_gt_zero zero_complex.simps)

lemma arg_pi_iff:
  shows "arg z = pi  is_real z  Re z < 0"
  by (smt arg_complex_of_real_negative arg_complex_of_real_positive arg_zero complex_of_real_Re is_real_arg1 pi_gt_zero zero_complex.simps)


text @{term arg} of imaginary numbers›

lemma is_imag_arg1:
  assumes "arg z = pi/2  arg z = -pi/2"
  shows "is_imag z"
  using assms
  using rcis_cmod_arg[of z] Re_rcis[of "cmod z" "arg z"]
  by (metis cos_minus cos_pi_half minus_divide_left mult_eq_0_iff)

lemma is_imag_arg2:
  assumes "is_imag z" and "z  0"
  shows "arg z = pi/2  arg z = -pi/2"
  using arg_bounded assms cos_0_iff_canon cos_arg_i_mult_zero by presburger

lemma arg_complex_of_real_times_i_positive [simp]:
  assumes "k > 0"
  shows "arg (cor k * 𝗂) = pi / 2"
proof-
  have "sin (arg (Complex 0 k)) > 0"
    using k > 0 rcis_cmod_arg[of "Complex 0 k"] Im_rcis[of "cmod (Complex 0 k)" "arg (Complex 0 k)"]
    by (smt complex.sel(2) mult_nonneg_nonpos norm_ge_zero)
  thus ?thesis
    using assms is_imag_arg2[of "cor k * 𝗂"]
    using arg_zero complex_of_real_i
    by force
qed

lemma arg_complex_of_real_times_i_negative [simp]:
  assumes "k < 0"
  shows "arg (cor k * 𝗂) = - pi / 2"
proof-
  have "sin (arg (Complex 0 k)) < 0"
    using k < 0 rcis_cmod_arg[of "Complex 0 k"] Im_rcis[of "cmod (Complex 0 k)" "arg (Complex 0 k)"]
    by (metis complex.sel(2) mult_less_0_iff norm_not_less_zero)
  thus ?thesis
    using assms is_imag_arg2[of "cor k * 𝗂"]
    using arg_zero complex_of_real_i[of k]
    by (smt complex.sel(1) sin_pi_half sin_zero)
qed

lemma arg_pi2_iff:
  shows "z  0  arg z = pi / 2  is_imag z  Im z > 0"
  by (smt Im_rcis Re_i_times Re_rcis arcsin_minus_1 cos_pi_half divide_minus_left mult.commute mult_cancel_right1 rcis_cmod_arg is_imag_arg2 sin_arcsin sin_pi_half zero_less_mult_pos zero_less_norm_iff)

lemma arg_minus_pi2_iff:
  shows "z  0  arg z = - pi / 2  is_imag z  Im z < 0"
  by (smt arg_pi2_iff complex.expand divide_cancel_right pi_neq_zero is_imag_arg1 is_imag_arg2 zero_complex.simps(1) zero_complex.simps(2))

lemma arg_ii [simp]:
  shows "arg 𝗂 = pi/2"
  by (metis arg_pi2_iff imaginary_unit.sel zero_less_one)

lemma arg_minus_ii [simp]: 
  shows "arg (-𝗂) = -pi/2"
proof-
  have "-𝗂 = cis (arg (- 𝗂))"
    using rcis_cmod_arg[of "-𝗂"]
    by (simp add: rcis_def)
  hence "cos (arg (-𝗂)) = 0" "sin (arg (-𝗂)) = -1"
    using cis.simps[of "arg (-𝗂)"]
    by auto
  thus ?thesis
    using cos_0_iff_canon[of "arg (-𝗂)"] arg_bounded[of "-𝗂"]
    by fastforce
qed

text ‹Argument is a canonical angle›

lemma canon_ang_arg:
  shows "arg z = arg z"
  using canon_ang_id[of "arg z"] arg_bounded
  by simp

lemma arg_cis:
  shows "arg (cis φ) = φ"
  using arg_unique canon_ang canon_ang_cos canon_ang_sin cis.ctr sgn_cis by presburger

text ‹Cosine and sine of @{term arg}

lemma cos_arg:
  assumes "z  0"
  shows "cos (arg z) = Re z / cmod z"
  by (metis Complex.Re_sgn cis.simps(1) assms cis_arg)

lemma sin_arg:
  assumes "z  0"
  shows "sin (arg z) = Im z / cmod z"
  by (metis Complex.Im_sgn cis.simps(2) assms cis_arg)

text ‹Argument of product›

lemma cis_arg_mult:
  assumes "z1 * z2  0"
  shows "cis (arg (z1 * z2)) = cis (arg z1 + arg z2)"
  by (metis assms cis_arg cis_mult mult_eq_0_iff sgn_mult)

lemma arg_mult_2kpi:
  assumes "z1 * z2  0"
  shows " k::int. arg (z1 * z2) = arg z1 + arg z2 + 2*k*pi"
proof-
  have "cis (arg (z1*z2)) = cis (arg z1 + arg z2)"
    by (rule cis_arg_mult[OF assms])
  thus ?thesis
    using cis_eq[of "arg (z1*z2)" "arg z1 + arg z2"]
    by (auto simp add: field_simps)
qed

lemma arg_mult:
  assumes "z1 * z2  0"
  shows "arg(z1 * z2) = arg z1 + arg z2"
proof-
  obtain k::int where "arg(z1 * z2) = arg z1 + arg z2 + 2*k*pi"
    using arg_mult_2kpi[of z1 z2]
    using assms
    by auto
  hence "arg(z1 * z2) = arg z1 + arg z2"
    using canon_ang_eq
    by(simp add:field_simps)
  thus ?thesis
    using canon_ang_arg[of "z1*z2"]
    by auto
qed

lemma arg_mult_real_positive [simp]:
  assumes "k > 0"
  shows "arg (cor k * z) = arg z"
proof (cases "z = 0")
  case False
  thus ?thesis
    using arg_mult assms canon_ang_arg by force
qed (auto simp: arg_zero)

lemma arg_mult_real_negative [simp]:
  assumes "k < 0"
  shows "arg (cor k * z) = arg (-z)"
proof (cases "z = 0")
  case False
  thus ?thesis
    using assms
    by (metis arg_mult_real_positive minus_mult_commute neg_0_less_iff_less of_real_minus minus_minus)
qed (auto simp: arg_zero)

lemma arg_div_real_positive [simp]:
  assumes "k > 0"
  shows "arg (z / cor k) = arg z"
proof(cases "z = 0")
  case True
  thus ?thesis
    by auto
next
  case False
  thus ?thesis
    using assms
    using arg_mult_real_positive[of "1/k" z]
    by auto
qed

lemma arg_div_real_negative [simp]:
  assumes "k < 0"
  shows "arg (z / cor k) = arg (-z)"
proof(cases "z = 0")
  case True
  thus ?thesis
    by auto
next
  case False
  thus ?thesis
    using assms
    using arg_mult_real_negative[of "1/k" z]
    by auto
qed

lemma arg_mult_eq:
  assumes "z * z1  0" and "z * z2  0"
  assumes "arg (z * z1) = arg (z * z2)"
  shows "arg z1 = arg z2"
  by (metis (no_types, lifting) arg_cis assms canon_ang_arg cis_arg mult_eq_0_iff nonzero_mult_div_cancel_left sgn_divide)

text ‹Argument of conjugate›

lemma arg_cnj_pi:
  assumes "arg z = pi"
  shows "arg (cnj z) = pi"
  using arg_pi_iff assms by auto

lemma arg_cnj_not_pi:
  assumes "arg z  pi"
  shows "arg (cnj z) = -arg z"
proof(cases "arg z = 0")
  case True
  thus ?thesis
    using eq_cnj_iff_real[of z] is_real_arg1[of z] by force
next
  case False
  have "arg (cnj z) = arg z  arg(cnj z) = -arg z"
    using arg_bounded[of z] arg_bounded[of "cnj z"]
    by (smt (verit, best) arccos_cos arccos_cos2 cnj.sel(1) complex_cnj_zero_iff complex_mod_cnj cos_arg)
  moreover
  have "arg (cnj z)  arg z"
    using sin_0_iff_canon[of "arg (cnj z)"] arg_bounded False assms
    by (metis complex_mod_cnj eq_cnj_iff_real is_real_arg2 rcis_cmod_arg)
  ultimately
  show ?thesis
    by auto
qed

text ‹Argument of reciprocal›

lemma arg_inv_not_pi:
  assumes "z  0" and "arg z  pi"
  shows "arg (1 / z) = - arg z"
proof-
  have "1/z = cnj z / cor ((cmod z)2 )"
    using z  0 complex_mult_cnj_cmod[of z]
    by (auto simp add:field_simps)
  thus ?thesis
    using arg_div_real_positive[of "(cmod z)2" "cnj z"] z  0
    using arg_cnj_not_pi[of z] ‹arg z  pi›
    by auto
qed

lemma arg_inv_pi:
  assumes "z  0" and "arg z = pi"
  shows "arg (1 / z) = pi"
proof-
  have "1/z = cnj z / cor ((cmod z)2 )"
    using z  0 complex_mult_cnj_cmod[of z]
    by (auto simp add:field_simps)
  thus ?thesis
    using arg_div_real_positive[of "(cmod z)2" "cnj z"] z  0
    using arg_cnj_pi[of z] ‹arg z = pi›
    by auto
qed

lemma arg_inv_2kpi:
  assumes "z  0"
  shows " k::int. arg (1 / z) = - arg z + 2*k*pi"
  using arg_inv_pi[OF assms]
  using arg_inv_not_pi[OF assms]
  by (cases "arg z = pi") (rule_tac x="1" in exI, simp, rule_tac x="0" in exI, simp)

lemma arg_inv:
  assumes "z  0"
  shows "arg (1 / z) = - arg z"
  by (metis arg_inv_not_pi arg_inv_pi assms canon_ang_arg canon_ang_uminus_pi)

text ‹Argument of quotient›

lemma arg_div_2kpi:
  assumes "z1  0" and "z2  0"
  shows " k::int. arg (z1 / z2) = arg z1 - arg z2 + 2*k*pi"
proof-
  obtain x1 where "arg (z1 * (1 / z2)) = arg z1 + arg (1 / z2) + 2 * real_of_int x1 * pi"
    using assms arg_mult_2kpi[of z1 "1/z2"]
    by auto
  moreover
  obtain x2 where "arg (1 / z2) = - arg z2 + 2 * real_of_int x2 * pi"
    using assms arg_inv_2kpi[of z2]
    by auto
  ultimately
  show ?thesis
    by (rule_tac x="x1 + x2" in exI, simp add: field_simps)
qed

lemma arg_div:
  assumes "z1  0" and "z2  0"
  shows "arg(z1 / z2) = arg z1 - arg z2"
proof-
  obtain k::int where "arg(z1 / z2) = arg z1 - arg z2 + 2*k*pi"
    using arg_div_2kpi[of z1 z2]
    using assms
    by auto
  hence "canon_ang(arg(z1 / z2)) = canon_ang(arg z1 - arg z2)"
    using canon_ang_eq
    by(simp add:field_simps)
  thus ?thesis
    using canon_ang_arg[of "z1/z2"]
    by auto
qed

text ‹Argument of opposite›

lemma arg_uminus:
  assumes "z  0"
  shows "arg (-z) = arg z + pi"
  using assms
  using arg_mult[of "-1" z]
  using arg_complex_of_real_negative[of "-1"]
  by (auto simp add: field_simps)

lemma arg_uminus_opposite_sign:
  assumes "z  0"
  shows "arg z > 0  ¬ arg (-z) > 0"
proof (cases "arg z = 0")
  case True
  thus ?thesis
    using assms
    by (simp add: arg_uminus)
next
  case False
  show ?thesis
  proof (cases "arg z > 0")
    case True
    thus ?thesis
      using assms
      using arg_bounded[of z]
      using canon_ang_plus_pi1[of "arg z"]
      by (simp add: arg_uminus)
  next
    case False
    thus ?thesis
      using ‹arg z  0
      using assms
      using arg_bounded[of z]
      using canon_ang_plus_pi2[of "arg z"]
      by (simp add: arg_uminus)
  qed
qed

text ‹Sign of argument is the same as the sign of the Imaginary part›

lemma arg_Im_sgn:
  assumes "¬ is_real z"
  shows "sgn (arg z) = sgn (Im z)"
proof-
  have "z  0"
    using assms
    by auto
  then obtain r φ where polar: "z = cor r * cis φ" "φ = arg z" "r > 0"
    by (smt cmod_cis mult_eq_0_iff norm_ge_zero of_real_0)
  hence "Im z = r * sin φ"
    by (metis Im_mult_real Re_complex_of_real cis.simps(2) Im_complex_of_real)
  hence  "Im z > 0  sin φ > 0" "Im z < 0  sin φ < 0"
    using r > 0
    using mult_pos_pos mult_nonneg_nonneg zero_less_mult_pos mult_less_cancel_left
    by smt+
  moreover
  have "φ  pi" "φ  0"
    using ¬ is_real z polar cis_pi
    by force+
  hence "sin φ > 0  φ > 0" "φ < 0  sin φ < 0"
    using φ = arg z φ  0 φ  pi›
    using arg_bounded[of z]
    by (smt sin_gt_zero sin_le_zero sin_pi_minus sin_0_iff_canon sin_ge_zero)+
  ultimately
  show ?thesis
    using φ = arg z
    by auto
qed


subsubsection ‹Complex square root›

definition
  "ccsqrt z = rcis (sqrt (cmod z)) (arg z / 2)"

lemma square_ccsqrt [simp]:
  shows "(ccsqrt x)2 = x"
  unfolding ccsqrt_def
  by (subst DeMoivre2) (simp add: rcis_cmod_arg)

lemma ex_complex_sqrt:
  shows " s::complex. s*s = z"
  unfolding power2_eq_square[symmetric]
  by (rule_tac x="csqrt z" in exI) simp

lemma ccsqrt:
  assumes "s * s = z"
  shows "s = ccsqrt z  s = -ccsqrt z"
proof (cases "s = 0")
  case True
  thus ?thesis
    using assms
    unfolding ccsqrt_def
    by simp
next
  case False
  then obtain k::int where "cmod s * cmod s = cmod z" "2 * arg s - arg z = 2*k*pi"
    using assms
    using rcis_cmod_arg[of z] rcis_cmod_arg[of s]
    using arg_mult[of s s]
    using canon_ang(3)[of "2*arg s"]
    by (auto simp add: norm_mult arg_mult)
  have *: "sqrt (cmod z) = cmod s"
    using ‹cmod s * cmod s = cmod z
    by (smt norm_not_less_zero real_sqrt_abs2)

  have **: "arg z / 2 = arg s - k*pi"
    using 2 * arg s - arg z = 2*k*pi›
    by simp

  have "cis (arg s - k*pi) = cis (arg s)  cis (arg s - k*pi) = -cis (arg s)"
  proof (cases "even k")
    case True
    hence "cis (arg s - k*pi) = cis (arg s)"
      by (simp add: cis_def complex.corec cos_diff sin_diff)
    thus ?thesis
      by simp
  next
    case False
    hence "cis (arg s - k*pi) = -cis (arg s)"
      by (simp add: cis_def complex.corec Complex_eq cos_diff sin_diff)
    thus ?thesis
      by simp
  qed
  thus ?thesis
  proof
    assume ***: "cis (arg s - k * pi) = cis (arg s)"
    hence "s = ccsqrt z"
      using rcis_cmod_arg[of s]
      unfolding ccsqrt_def rcis_def
      by (subst *, subst **, subst ***, simp)
    thus ?thesis
      by simp
  next
    assume ***: "cis (arg s - k * pi) = -cis (arg s)"
    hence "s = - ccsqrt z"
      using rcis_cmod_arg[of s]
      unfolding ccsqrt_def rcis_def
      by (subst *, subst **, subst ***, simp)
    thus ?thesis
      by simp
  qed
qed

lemma null_ccsqrt [simp]:
  shows "ccsqrt x = 0  x = 0"
  unfolding ccsqrt_def
  by auto

lemma ccsqrt_mult:
  shows "ccsqrt (a * b) = ccsqrt a * ccsqrt b 
         ccsqrt (a * b) = - ccsqrt a * ccsqrt b"
proof (cases "a = 0  b = 0")
  case True
  thus ?thesis
    by auto
next
  case False
  obtain k::int where "arg a + arg b - arg a + arg b = 2 * real_of_int k * pi"
    using canon_ang(3)[of "arg a + arg b"]
    by auto
  hence *: "arg a + arg b = arg a + arg b - 2 * (real_of_int k) * pi"
    by (auto simp add: field_simps)

  have "cis (arg a + arg b / 2) = cis (arg a / 2 + arg b / 2)  cis (arg a + arg b / 2) = - cis (arg a / 2 + arg b / 2)"
    using cos_even_kpi[of k] cos_odd_kpi[of k]
    by ((subst *)+, (subst diff_divide_distrib)+, (subst add_divide_distrib)+)
       (cases "even k", auto simp add: cis_def complex.corec Complex_eq cos_diff sin_diff)
  thus ?thesis
    using False
    unfolding ccsqrt_def
    by (smt (verit, best) arg_mult mult_minus_left mult_minus_right no_zero_divisors norm_mult rcis_def rcis_mult real_sqrt_mult)
qed

lemma csqrt_real:
  assumes "is_real x"
  shows "(Re x  0  ccsqrt x = cor (sqrt (Re x))) 
         (Re x < 0  ccsqrt x = 𝗂 * cor (sqrt (- (Re x))))"
proof (cases "x = 0")
  case True
  thus ?thesis
    by auto
next
  case False
  show ?thesis
  proof (cases "Re x > 0")
    case True
    hence "arg x = 0"
      using ‹is_real x
      by (metis arg_complex_of_real_positive complex_of_real_Re)
    thus ?thesis
      using ‹Re x > 0 ‹is_real x
      unfolding ccsqrt_def
      by (simp add: cmod_eq_Re)
  next
    case False
    hence "Re x < 0"
      using x  0 ‹is_real x
      using complex_eq_if_Re_eq by auto
    hence "arg x = pi"
      using ‹is_real x
      by (metis arg_complex_of_real_negative complex_of_real_Re)
    thus ?thesis
      using ‹Re x < 0 ‹is_real x
      unfolding ccsqrt_def rcis_def
      by (simp add: cis_def complex.corec Complex_eq cmod_eq_Re)
  qed
qed


text ‹Rotation of complex vector to x-axis.›

lemma is_real_rot_to_x_axis:
  assumes "z  0"
  shows "is_real (cis (-arg z) * z)"
proof (cases "arg z = pi")
  case True
  thus ?thesis
    using is_real_arg1[of z]
    by auto
next
  case False
  hence "- arg z = - arg z"
    using canon_ang_eqI[of "- arg z" "-arg z"]
    using arg_bounded[of z]
    by (auto simp add: field_simps)
  hence "arg (cis (- (arg z)) * z) = 0"
    using arg_mult[of "cis (- (arg z))" z] z  0
    using arg_cis[of "- arg z"]
    by simp
  thus ?thesis
    using is_real_arg1[of "cis (- arg z) * z"]
    by auto
qed

lemma positive_rot_to_x_axis:
  assumes "z  0"
  shows "Re (cis (-arg z) * z) > 0"
  using assms
  by (smt Re_complex_of_real cis_rcis_eq mult_cancel_right1 rcis_cmod_arg rcis_mult rcis_zero_arg zero_less_norm_iff)

text ‹Inequalities involving @{term cmod}.›

lemma cmod_1_plus_mult_le:
  shows "cmod (1 + z*w)  sqrt((1 + (cmod z)2) * (1 + (cmod w)2))"
proof-
  have "Re ((1+z*w)*(1+cnj z*cnj w))  Re (1+z*cnj z)* Re (1+w*cnj w)"
  proof-
    have "Re ((w - cnj z)*cnj(w - cnj z))  0"
      by (subst complex_mult_cnj_cmod) (simp add: power2_eq_square)
    hence "Re (z*w + cnj z * cnj w)  Re (w*cnj w) + Re(z*cnj z)"
      by (simp add: field_simps)
    thus ?thesis
      by (simp add: field_simps)
  qed
  hence "(cmod (1 + z * w))2  (1 + (cmod z)2) * (1 + (cmod w)2)"
    by (subst cmod_square)+ simp
  thus ?thesis
    by (metis abs_norm_cancel real_sqrt_abs real_sqrt_le_iff)
qed

lemma cmod_diff_ge: 
  shows "cmod (b - c)  sqrt (1 + (cmod b)2) - sqrt (1 + (cmod c)2)"
proof-
  have "(cmod (b - c))2 + (1/2*Im(b*cnj c - c*cnj b))2  0"
    by simp
  hence "(cmod (b - c))2  - (1/2*Im(b*cnj c - c*cnj b))2"
    by simp
  hence "(cmod (b - c))2  (1/2*Re(b*cnj c + c*cnj b))2 - Re(b*cnj b*c*cnj c) "
    by (auto simp add: power2_eq_square field_simps)
  hence "Re ((b - c)*(cnj b - cnj c))  (1/2*Re(b*cnj c + c*cnj b))2 - Re(b*cnj b*c*cnj c)"
    by (subst (asm) cmod_square) simp
  moreover
  have "(1 + (cmod b)2) * (1 + (cmod c)2) = 1 + Re(b*cnj b) + Re(c*cnj c) + Re(b*cnj b*c*cnj c)"
    by (subst cmod_square)+ (simp add: field_simps power2_eq_square)
  moreover
  have "(1 + Re (scalprod b c))2 = 1 + 2*Re(scalprod b c) + ((Re (scalprod b c))2)"
    by (subst power2_sum) simp
  hence "(1 + Re (scalprod b c))2 = 1 + Re(b*cnj c + c*cnj b) + (1/2 * Re (b*cnj c + c*cnj b))2"
    by simp
  ultimately
  have "(1 + (cmod b)2) * (1 + (cmod c)2)  (1 + Re (scalprod b c))2"
    by (simp add: field_simps)
  moreover
  have "sqrt((1 + (cmod b)2) * (1 + (cmod c)2))  0"
    by (metis one_power2 real_sqrt_sum_squares_mult_ge_zero)
  ultimately
  have "sqrt((1 + (cmod b)2) * (1 + (cmod c)2))  1 + Re (scalprod b c)"
    by (metis power2_le_imp_le real_sqrt_ge_0_iff real_sqrt_pow2_iff)
  hence "Re ((b - c) * (cnj b - cnj c))  1 + Re (c*cnj c) + 1 + Re (b*cnj b) - 2*sqrt((1 + (cmod b)2) * (1 + (cmod c)2))"
    by (simp add: field_simps)
  hence *: "(cmod (b - c))2  (sqrt (1 + (cmod b)2) - sqrt (1 + (cmod c)2))2"
    apply (subst cmod_square)+
    apply (subst (asm) cmod_square)+
    apply (subst power2_diff)
    apply (subst real_sqrt_pow2, simp)
    apply (subst real_sqrt_pow2, simp)
    apply (simp add: real_sqrt_mult)
    done
  thus ?thesis
  proof (cases "sqrt (1 + (cmod b)2) - sqrt (1 + (cmod c)2) > 0")
    case True
    thus ?thesis
      using power2_le_imp_le[OF *]
      by simp
  next
    case False
    hence "0  sqrt (1 + (cmod b)2) - sqrt (1 + (cmod c)2)"
      by (metis less_eq_real_def linorder_neqE_linordered_idom)
    moreover
    have "cmod (b - c)  0"
      by simp
    ultimately
    show ?thesis
      by (metis add_increasing monoid_add_class.add.right_neutral)
  qed
qed

lemma cmod_diff_le:
  shows "cmod (b - c)  sqrt (1 + (cmod b)2) + sqrt (1 + (cmod c)2)"
proof-
  have "(cmod (b + c))2 + (1/2*Im(b*cnj c - c*cnj b))2  0"
    by simp
  hence "(cmod (b + c))2  - (1/2*Im(b*cnj c - c*cnj b))2"
    by simp
  hence "(cmod (b + c))2  (1/2*Re(b*cnj c + c*cnj b))2 - Re(b*cnj b*c*cnj c) "
    by (auto simp add: power2_eq_square field_simps)
  hence "Re ((b + c)*(cnj b + cnj c))  (1/2*Re(b*cnj c + c*cnj b))2 - Re(b*cnj b*c*cnj c)"
    by (subst (asm) cmod_square) simp
  moreover
  have "(1 + (cmod b)2) * (1 + (cmod c)2) = 1 + Re(b*cnj b) + Re(c*cnj c) + Re(b*cnj b*c*cnj c)"
    by (subst cmod_square)+ (simp add: field_simps power2_eq_square)
  moreover
  have ++: "2*Re(scalprod b c) = Re(b*cnj c + c*cnj b)"
    by simp
  have "(1 - Re (scalprod b c))2 = 1 - 2*Re(scalprod b c) + ((Re (scalprod b c))2)"
    by (subst power2_diff) simp
  hence "(1 - Re (scalprod b c))2 = 1 - Re(b*cnj c + c*cnj b) + (1/2 * Re (b*cnj c + c*cnj b))2"
    by (subst ++[symmetric]) simp
  ultimately
  have "(1 + (cmod b)2) * (1 + (cmod c)2)  (1 - Re (scalprod b c))2"
    by (simp add: field_simps)
  moreover
  have "sqrt((1 + (cmod b)2) * (1 + (cmod c)2))  0"
    by (metis one_power2 real_sqrt_sum_squares_mult_ge_zero)
  ultimately
  have "sqrt((1 + (cmod b)2) * (1 + (cmod c)2))  1 - Re (scalprod b c)"
    by (metis power2_le_imp_le real_sqrt_ge_0_iff real_sqrt_pow2_iff)
  hence "Re ((b - c) * (cnj b - cnj c))  1 + Re (c*cnj c) + 1 + Re (b*cnj b) + 2*sqrt((1 + (cmod b)2) * (1 + (cmod c)2))"
    by (simp add: field_simps)
  hence *: "(cmod (b - c))2  (sqrt (1 + (cmod b)2) + sqrt (1 + (cmod c)2))2"
    apply (subst cmod_square)+
    apply (subst (asm) cmod_square)+
    apply (subst power2_sum)
    apply (subst real_sqrt_pow2, simp)
    apply (subst real_sqrt_pow2, simp)
    apply (simp add: real_sqrt_mult)
    done
  thus ?thesis
    using power2_le_imp_le[OF *]
    by simp
qed


text ‹Definition of Euclidean distance between two complex numbers.›

definition cdist where
  [simp]: "cdist z1 z2  cmod (z2 - z1)"

text ‹Misc. properties of complex numbers.›

lemma ex_complex_to_complex [simp]:
  fixes z1 z2 :: complex
  assumes "z1  0" and "z2  0"
  shows "k. k  0  z2 = k * z1"
  using assms
  by (rule_tac x="z2/z1" in exI) simp

lemma ex_complex_to_one [simp]:
  fixes z::complex
  assumes "z  0"
  shows "k. k  0  k * z = 1"
  using assms
  by (rule_tac x="1/z" in exI) simp

lemma ex_complex_to_complex2 [simp]:
  fixes z::complex
  shows "k. k  0  k * z = z"
  by (rule_tac x="1" in exI) simp

lemma complex_sqrt_1:
  fixes z::complex
  assumes "z  0"
  shows "z = 1 / z  z = 1  z = -1"
  using assms
  using nonzero_eq_divide_eq square_eq_iff
  by fastforce

end

Theory Angles

(* ---------------------------------------------------------------------------- *)
subsection ‹Angle between two vectors›
(* ---------------------------------------------------------------------------- *)

text ‹In this section we introduce different measures of angle between two vectors (represented by complex numbers).›

theory Angles
imports More_Transcendental Canonical_Angle More_Complex
begin

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Oriented angle›
(* ---------------------------------------------------------------------------- *)

text ‹Oriented angle between two vectors (it is always in the interval $(-\pi, \pi]$).›
definition ang_vec ("") where
  [simp]: " z1 z2  arg z2 - arg z1"

lemma ang_vec_bounded:
  shows "-pi <  z1 z2   z1 z2  pi"
  by (simp add: canon_ang(1) canon_ang(2))

lemma ang_vec_sym:
  assumes " z1 z2  pi"
  shows " z1 z2 = -  z2 z1"
  using assms
  unfolding ang_vec_def
  using canon_ang_uminus[of "arg z2 - arg z1"]
  by simp

lemma ang_vec_sym_pi:
  assumes " z1 z2 = pi"
  shows " z1 z2 =  z2 z1"
  using assms
  unfolding ang_vec_def
  using canon_ang_uminus_pi[of "arg z2 - arg z1"]
  by simp

lemma ang_vec_plus_pi1:
  assumes " z1 z2 > 0"
  shows " z1 z2 + pi =  z1 z2 - pi"
proof (rule canon_ang_eqI)
  show " x::int.  z1 z2 - pi - ( z1 z2 + pi) = 2 * real_of_int x * pi"
    by (rule_tac x="-1" in exI) auto
next
  show "- pi <  z1 z2 - pi   z1 z2 - pi  pi"
    using assms
    unfolding ang_vec_def
    using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
    by auto
qed

lemma ang_vec_plus_pi2:
  assumes " z1 z2  0"
  shows " z1 z2 + pi =  z1 z2 + pi"
proof (rule canon_ang_id)
  show "- pi <  z1 z2 + pi   z1 z2 + pi  pi"
    using assms
    unfolding ang_vec_def
    using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
    by auto
qed

lemma ang_vec_opposite1:
  assumes "z1  0"
  shows " (-z1) z2 =  z1 z2 - pi"
proof-
  have " (-z1) z2 = arg z2 - (arg z1 + pi)"
    unfolding ang_vec_def
    using arg_uminus[OF assms] 
    using canon_ang_arg[of z2, symmetric]
    using canon_ang_diff[of "arg z2" "arg z1 + pi", symmetric]
    by simp
  moreover
  have " z1 z2 - pi = arg z2 - arg z1 - pi"
    using canon_ang_id[of pi, symmetric]
    using canon_ang_diff[of "arg z2 - arg z1" "pi", symmetric]
    by simp_all
  ultimately
  show ?thesis
    by (simp add: field_simps)
qed

lemma ang_vec_opposite2:
  assumes "z2  0"
  shows " z1 (-z2) =  z1 z2 + pi"
  unfolding ang_vec_def
  using arg_mult[of "-1" "z2"] assms
  using arg_complex_of_real_negative[of "-1"]
  using canon_ang_diff[of "arg (-1) + arg z2" "arg z1", symmetric]
  using canon_ang_sum[of "arg z2 - arg z1" "pi", symmetric]
  using canon_ang_id[of pi] canon_ang_arg[of z1]
  by (auto simp: algebra_simps)
  

lemma ang_vec_opposite_opposite:
  assumes "z1  0" and "z2  0"
  shows " (-z1) (-z2) =  z1 z2"
proof-
  have " (-z1) (-z2) =  z1 z2 + pi - pi"
    using ang_vec_opposite1[OF assms(1)]
    using ang_vec_opposite2[OF assms(2)]
    using canon_ang_id[of pi, symmetric]
    by simp_all
  also have "... =  z1 z2"
    by (subst canon_ang_diff[symmetric], simp)
  finally
  show ?thesis
    by (metis ang_vec_def canon_ang(1) canon_ang(2) canon_ang_id)
qed

lemma ang_vec_opposite_opposite':
  assumes "z1  z" and "z2  z"
  shows " (z - z1) (z - z2) =  (z1 - z) (z2 - z)"
using ang_vec_opposite_opposite[of "z - z1" "z - z2"] assms
by (simp add: field_simps del: ang_vec_def)

text ‹Cosine, scalar product and the law of cosines›

lemma cos_cmod_scalprod:
  shows "cmod z1 * cmod z2 * (cos ( z1 z2)) = Re (scalprod z1 z2)"
proof (cases "z1 = 0  z2 = 0")
  case True
  thus ?thesis
    by auto
next
  case False
  thus ?thesis
    by (simp add: cos_diff cos_arg sin_arg field_simps)
qed

lemma cos0_scalprod0:
  assumes "z1  0" and "z2  0"
  shows "cos ( z1 z2) = 0  scalprod z1 z2 = 0"
  using assms
  using cnj_mix_real[of z1 z2]
  using cos_cmod_scalprod[of z1 z2]
  by (auto simp add: complex_eq_if_Re_eq)

lemma ortho_scalprod0:
  assumes "z1  0" and "z2  0"
  shows " z1 z2 = pi/2   z1 z2 = -pi/2  scalprod z1 z2 = 0"
  using cos0_scalprod0[OF assms]
  using ang_vec_bounded[of z1 z2]
  using cos_0_iff_canon[of " z1 z2"]
  by (metis cos_minus cos_pi_half divide_minus_left)

lemma law_of_cosines:
  shows "(cdist B C)2 = (cdist A C)2 + (cdist A B)2 - 2*(cdist A C)*(cdist A B)*(cos ( (C-A) (B-A)))"
proof-
  let ?a = "C-B" and ?b = "C-A" and ?c = "B-A"
  have "?a = ?b - ?c"
    by simp
  hence "(cmod ?a)2 = (cmod (?b - ?c))2"
    by metis
  also have "... = Re (scalprod (?b-?c) (?b-?c))"
    by (simp add: cmod_square)
  also have "... = (cmod ?b)2 + (cmod ?c)2 - 2*Re (scalprod ?b ?c)"
    by (simp add: cmod_square field_simps)
  finally
  show ?thesis
    using cos_cmod_scalprod[of ?b ?c]
    by simp
qed

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Unoriented angle›
(* ---------------------------------------------------------------------------- *)

text ‹Convex unoriented angle between two vectors (it is always in the interval $[0, pi]$).›
definition ang_vec_c ("∠c") where
  [simp]:"∠c z1 z2  abs ( z1 z2)"

lemma ang_vec_c_sym:
  shows "∠c z1 z2 = ∠c z2 z1"
  unfolding ang_vec_c_def
  using ang_vec_sym_pi[of z1 z2] ang_vec_sym[of z1 z2]
  by (cases " z1 z2 = pi") auto

lemma ang_vec_c_bounded: "0  ∠c z1 z2  ∠c z1 z2  pi"
  using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
  by auto

text ‹Cosine and scalar product›

lemma cos_c_: "cos (∠c z1 z2) = cos ( z1 z2)"
  unfolding ang_vec_c_def
  by (smt cos_minus)

lemma ortho_c_scalprod0:
  assumes "z1  0" and "z2  0"
  shows "∠c z1 z2 = pi/2  scalprod z1 z2 = 0"
proof-
  have " z1 z2 = pi / 2   z1 z2 = - pi / 2  ∠c z1 z2 = pi/2"
    unfolding ang_vec_c_def
    using arctan 
    by force
  thus ?thesis
    using ortho_scalprod0[OF assms]
    by simp
qed

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Acute angle›
(* ---------------------------------------------------------------------------- *)

text ‹Acute or right angle (non-obtuse) between two vectors (it is always in the interval $[0, \frac{\pi}{2}$]).
We will use this to measure angle between two circles, since it can always be acute (or right).›

definition acute_ang where
  [simp]: "acute_ang α = (if α > pi / 2 then pi - α else α)"

definition ang_vec_a ("∠a") where
  [simp]: "∠a z1 z2  acute_ang (∠c z1 z2)"

lemma ang_vec_a_sym:
  "∠a z1 z2 = ∠a z2 z1"
  unfolding ang_vec_a_def
  using ang_vec_c_sym
  by auto

lemma ang_vec_a_opposite2:
  "∠a z1 z2 = ∠a z1 (-z2)"
proof(cases "z2  = 0")
  case True
  thus ?thesis
    by (metis minus_zero)
next
  case False
  thus ?thesis
  proof(cases " z1 z2 < -pi / 2")
    case True
    hence " z1 z2 < 0"
      using pi_not_less_zero
      by linarith
    have "∠a z1 z2 = pi +  z1 z2"
      using True  z1 z2 < 0
      unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def
      by auto
    moreover
    have "∠a z1 (-z2) = pi +  z1 z2"
      unfolding ang_vec_a_def ang_vec_c_def abs_real_def
      using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
      using ang_vec_plus_pi2[of z1 z2] True  z1 z2 < 0 z2  0
      using ang_vec_opposite2[of z2 z1]
      by auto
    ultimately
    show ?thesis
      by auto
  next
    case False
    show ?thesis
    proof (cases " z1 z2  0")
      case True
      have "∠a z1 z2 = -  z1 z2"
        using ¬  z1 z2 < - pi / 2 True
        unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def
        by auto
      moreover
      have "∠a z1 (-z2) = -  z1 z2"
        using ¬  z1 z2 < - pi / 2 True
        unfolding ang_vec_a_def ang_vec_c_def abs_real_def
        using ang_vec_plus_pi2[of z1 z2]
        using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
        using z2  0 ang_vec_opposite2[of z2 z1]
        by auto
      ultimately
      show ?thesis
        by simp
    next
      case False
      show ?thesis
      proof (cases " z1 z2 < pi / 2")
        case True
        have "∠a z1 z2 =  z1 z2"
          using ¬  z1 z2  0 True
          unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def
          by auto
        moreover
        have "∠a z1 (-z2) =  z1 z2"
          using ¬  z1 z2  0 True
          unfolding ang_vec_a_def ang_vec_c_def abs_real_def
          using ang_vec_plus_pi1[of z1 z2]
          using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
          using z2  0 ang_vec_opposite2[of z2 z1]
          by auto
        ultimately
        show ?thesis
          by simp
      next
        case False
        have " z1 z2 > 0"
          using False
          by (metis less_linear less_trans pi_half_gt_zero)
        have "∠a z1 z2 = pi -  z1 z2"
          using False  z1 z2 > 0
          unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def
          by auto
        moreover
        have "∠a z1 (-z2) = pi -  z1 z2"
          unfolding ang_vec_a_def ang_vec_c_def abs_real_def
          using False  z1 z2 > 0
          using ang_vec_plus_pi1[of z1 z2]
          using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
          using z2  0 ang_vec_opposite2[of z2 z1]
          by auto
        ultimately
        show ?thesis
          by auto
      qed
    qed
  qed
qed

lemma ang_vec_a_opposite1:
  shows "∠a z1 z2 = ∠a (-z1) z2"
  using ang_vec_a_sym[of "-z1" z2] ang_vec_a_opposite2[of z2 z1] ang_vec_a_sym[of z2 z1]
  by auto

lemma ang_vec_a_scale1:
  assumes "k  0"
  shows "∠a (cor k * z1) z2 = ∠a z1 z2"
proof (cases "k > 0")
  case True
  thus ?thesis
    unfolding ang_vec_a_def ang_vec_c_def ang_vec_def
    using arg_mult_real_positive[of k z1]
    by auto
next
  case False
  hence "k < 0"
    using assms
    by auto
  thus ?thesis
    using arg_mult_real_negative[of k z1]
    using ang_vec_a_opposite1[of z1 z2]
    unfolding ang_vec_a_def ang_vec_c_def ang_vec_def
    by simp
qed

lemma ang_vec_a_scale2:
  assumes "k  0"
  shows "∠a z1 (cor k * z2) = ∠a z1 z2"
  using ang_vec_a_sym[of z1 "complex_of_real k * z2"]
  using ang_vec_a_scale1[OF assms, of z2 z1]
  using ang_vec_a_sym[of z1 z2]
  by auto

lemma ang_vec_a_scale:
  assumes "k1  0" and "k2  0"
  shows "∠a (cor k1 * z1) (cor k2 * z2) = ∠a z1 z2"
  using ang_vec_a_scale1[OF assms(1)] ang_vec_a_scale2[OF assms(2)]
  by auto

lemma ang_a_cnj_cnj:
  shows "∠a z1 z2 = ∠a (cnj z1) (cnj z2)"
unfolding ang_vec_a_def ang_vec_c_def ang_vec_def
proof(cases "arg z1  pi  arg z2  pi")
  case True
  thus "acute_ang ¦arg z2 - arg z1¦ = acute_ang ¦arg (cnj z2) - arg (cnj z1)¦"
    using arg_cnj_not_pi[of z1] arg_cnj_not_pi[of z2]
    apply (auto simp del:acute_ang_def)
    proof(cases "arg z2 - arg z1 = pi")
      case True
      thus "acute_ang ¦arg z2 - arg z1¦ = acute_ang ¦arg z1 - arg z2¦"
        using  canon_ang_uminus_pi[of "arg z2 - arg z1"]
        by (auto simp add:field_simps)
    next
      case False
      thus "acute_ang ¦arg z2 - arg z1¦ = acute_ang ¦arg z1 - arg z2¦"
        using  canon_ang_uminus[of "arg z2 - arg z1"]
        by (auto simp add:field_simps)
    qed
  next
    case False
    thus "acute_ang ¦arg z2 - arg z1¦ = acute_ang ¦arg (cnj z2) - arg (cnj z1)¦"
    proof(cases "arg z1 = pi")
      case False
      hence "arg z2 = pi"
        using ¬ (arg z1  pi  arg z2  pi)
        by auto
      thus ?thesis
        using False
        using arg_cnj_not_pi[of z1] arg_cnj_pi[of z2]
        apply (auto simp del:acute_ang_def)
      proof(cases "arg z1 > 0")
          case True
          hence "-arg z1  0"
            by auto
          thus "acute_ang ¦pi - arg z1¦ = acute_ang ¦pi + arg z1¦"
            using True canon_ang_plus_pi1[of "arg z1"]
            using arg_bounded[of z1] canon_ang_plus_pi2[of "-arg z1"]
            by (auto simp add:field_simps)
        next
          case False
          hence "-arg z1  0"
             by simp
          thus "acute_ang ¦pi - arg z1¦ = acute_ang ¦pi + arg z1¦"
          proof(cases "arg z1 = 0")
            case True
            thus ?thesis
              by (auto simp del:acute_ang_def)
          next
            case False
            hence "-arg z1 > 0"
              using -arg z1  0
              by auto
            thus ?thesis
            using False canon_ang_plus_pi1[of "-arg z1"]
            using arg_bounded[of z1] canon_ang_plus_pi2[of "arg z1"]
            by (auto simp add:field_simps)
        qed
      qed
    next
      case True
      thus ?thesis
        using arg_cnj_pi[of z1]
        apply (auto simp del:acute_ang_def)
      proof(cases "arg z2 = pi")
        case True
        thus "acute_ang ¦arg z2 - pi¦ = acute_ang ¦arg (cnj z2) - pi¦"
          using arg_cnj_pi[of z2]
          by auto
      next
        case False
        thus "acute_ang ¦arg z2 - pi¦ = acute_ang ¦arg (cnj z2) - pi¦"
          using arg_cnj_not_pi[of z2]
          apply (auto simp del:acute_ang_def)
        proof(cases "arg z2 > 0")
          case True
          hence "-arg z2  0"
            by auto
          thus "acute_ang ¦arg z2 - pi¦ = acute_ang ¦- arg z2 - pi¦"
            using True canon_ang_minus_pi1[of "arg z2"]
            using arg_bounded[of z2] canon_ang_minus_pi2[of "-arg z2"]
            by (auto simp add: field_simps)
        next
          case False
          hence "-arg z2  0"
             by simp
          thus "acute_ang ¦arg z2 - pi¦ = acute_ang ¦- arg z2 - pi¦"
          proof(cases "arg z2 = 0")
            case True
            thus ?thesis
              by (auto simp del:acute_ang_def)
          next
            case False
            hence "-arg z2 > 0"
              using -arg z2  0
              by auto
            thus ?thesis
            using False canon_ang_minus_pi1[of "-arg z2"]
            using arg_bounded[of z2] canon_ang_minus_pi2[of "arg z2"]
            by (auto simp add:field_simps)
        qed
      qed
    qed
  qed
qed

text ‹Cosine and scalar product›

lemma ortho_a_scalprod0:
  assumes "z1  0" and "z2  0"
  shows "∠a z1 z2 = pi/2  scalprod z1 z2 = 0"
  unfolding ang_vec_a_def
  using assms ortho_c_scalprod0[of z1 z2]
  by auto

declare ang_vec_c_def[simp del]

lemma cos_a_c: "cos (∠a z1 z2) = abs (cos (∠c z1 z2))"
proof-
  have "0  ∠c z1 z2" "∠c z1 z2  pi"
    using ang_vec_c_bounded[of z1 z2]
    by auto
  show ?thesis
  proof (cases "∠c z1 z2 = pi/2")
    case True
    thus ?thesis
      unfolding ang_vec_a_def acute_ang_def
      by (smt cos_pi_half pi_def pi_half)
  next
    case False
    show ?thesis
    proof (cases "∠c z1 z2 < pi / 2")
      case True
      thus ?thesis
        using 0  ∠c z1 z2
        using cos_gt_zero_pi[of "∠c z1 z2"]
        unfolding ang_vec_a_def
        by simp
    next
      case False
      hence "∠c z1 z2 > pi/2"
        using ∠c z1 z2  pi/2
        by simp
      hence "cos (∠c z1 z2) < 0"
        using ∠c z1 z2  pi›
        using cos_lt_zero_on_pi2_pi[of "∠c z1 z2"] 
        by simp
      thus ?thesis
        using ∠c z1 z2 > pi/2
        unfolding ang_vec_a_def
        by simp
    qed
  qed
qed

end

Theory More_Set

(* ---------------------------------------------------------------------------- *)
subsection ‹Library Aditions for Set Cardinality›
(* ---------------------------------------------------------------------------- *)

text ‹In this section some additional simple lemmas about set cardinality are proved.›

theory More_Set
imports Main
begin

text ‹Every infinite set has at least two different elements›
lemma infinite_contains_2_elems:
  assumes "infinite A"
  shows " x y. x  y  x  A  y  A"
  by (metis assms finite.simps is_singletonI' is_singleton_def)

text ‹Every infinite set has at least three different elements›
lemma infinite_contains_3_elems:
  assumes "infinite A"
  shows " x y z. x  y  x  z  y  z  x  A  y  A  z  A"
  by (metis Diff_iff assms infinite_contains_2_elems infinite_remove insertI1)

text ‹Every set with cardinality greater than 1 has at least two different elements›
lemma card_geq_2_iff_contains_2_elems:
  shows "card A  2  finite A  ( x y. x  y  x  A  y  A)"
proof (intro iffI conjI)
  assume *: "finite A  ( x y. x  y  x  A  y  A)"
  thus "card A  2"
    by (metis card_0_eq card_Suc_eq empty_iff leI less_2_cases singletonD)
next
  assume *: "2  card A"
  then show "finite A"
    using card.infinite by force
  show " x y. x  y  x  A  y  A"
    by (meson "*" card_2_iff' in_mono obtain_subset_with_card_n)
qed

text ‹Set cardinality is at least 3 if and only if it contains three different elements›
lemma card_geq_3_iff_contains_3_elems:
  shows "card A  3  finite A  ( x y z. x  y  x  z  y  z  x  A  y  A  z  A)"
proof (intro iffI conjI)
  assume *: "card A  3"
  then show "finite A"
    using card.infinite by force
  show " x y z. x  y  x  z  y  z  x  A  y  A  z  A"
    by (smt (verit, best) "*" card_2_iff' card_geq_2_iff_contains_2_elems le_cases3 not_less_eq_eq numeral_2_eq_2 numeral_3_eq_3)
next
  assume *: "finite A  ( x y z. x  y  x  z  y  z  x  A  y  A  z  A)"
  thus "card A  3"
    by (metis One_nat_def Suc_le_eq card_2_iff' card_le_Suc0_iff_eq leI numeral_3_eq_3 one_add_one order_class.order.eq_iff plus_1_eq_Suc)
qed

text ‹Set cardinality of A is equal to 2 if and only if A={x, y} for two different elements x and y›
lemma card_eq_2_iff_doubleton: "card A = 2  ( x y. x  y  A = {x, y})"
  using card_geq_2_iff_contains_2_elems[of A]
  using card_geq_3_iff_contains_3_elems[of A]
  by auto (rule_tac x=x in exI, rule_tac x=y in exI, auto)

lemma card_eq_2_doubleton:
  assumes "card A = 2" and "x  y" and "x  A" and "y  A"
  shows "A = {x, y}"
  using assms card_eq_2_iff_doubleton[of A]
  by auto

text ‹Bijections map singleton to singleton sets›

lemma bij_image_singleton:
  shows "f ` A = {b}; f a = b; bij f  A = {a}"
  by (metis bij_betw_def image_empty image_insert inj_image_eq_iff)

end

Theory Linear_Systems

(* ---------------------------------------------------------------------------- *)
subsection ‹Systems of linear equations›
(* ---------------------------------------------------------------------------- *)
(* TODO: merge with matrices *)

text ‹In this section some simple properties of systems of linear equations with two or three unknowns are derived.
Existence and uniqueness of solutions of regular and singular homogenous and non-homogenous systems is characterized.›

theory Linear_Systems
imports Main
begin

text ‹Determinant of 2x2 matrix›
definition det2 :: "('a::field)  'a  'a  'a  'a" where
  [simp]: "det2 a11 a12 a21 a22  a11*a22 - a12*a21"

text ‹Regular homogenous system has only trivial solution›
lemma regular_homogenous_system:
  fixes a11 a12 a21 a22 x1 x2 :: "'a::field"
  assumes "det2 a11 a12 a21 a22  0"
  assumes "a11*x1 + a12*x2 = 0" and
          "a21*x1 + a22*x2 = 0"
  shows "x1 = 0  x2 = 0"
proof (cases "a11 = 0")
  case True
  with assms(1) have "a12  0" "a21  0"
    by auto
  thus ?thesis
    using a11 = 0 assms(2) assms(3)
    by auto
next
  case False
  hence "x1 = - a12*x2 / a11"
    using assms(2)
    by (metis eq_neg_iff_add_eq_0 mult_minus_left nonzero_mult_div_cancel_left)
  hence "a21 * (- a12 * x2 / a11) + a22 * x2 = 0"
    using assms(3)
    by simp
  hence "a21 * (- a12 * x2) + a22 * x2 * a11 = 0"
    using  a11  0
    by auto
  hence "(a11*a22 - a12*a21)*x2 = 0"
    by (simp add: field_simps)
  thus ?thesis
    using assms(1) assms(2) a11  0
    by auto
qed

text ‹Regular system has a unique solution›
lemma regular_system:
  fixes a11 a12 a21 a22 b1 b2 :: "'a::field"
  assumes "det2 a11 a12 a21 a22  0"
  shows "∃! x. a11*(fst x) + a12*(snd x) = b1 
               a21*(fst x) + a22*(snd x) = b2"
proof
  let ?d = "a11*a22 - a12*a21" and ?d1 = "b1*a22 - b2*a12" and ?d2 = "b2*a11 - b1*a21"
  let ?x = "(?d1 / ?d, ?d2 / ?d)"
  have "a11 * ?d1 + a12 * ?d2 = b1*?d" "a21 * ?d1 + a22 * ?d2 = b2*?d"
    by (auto simp add: field_simps)
  thus "a11 * fst ?x + a12 * snd ?x = b1  a21 * fst ?x + a22 * snd ?x = b2"
    using assms
    by (metis (hide_lams, no_types) det2_def add_divide_distrib eq_divide_imp fst_eqD snd_eqD times_divide_eq_right)

  fix x'
  assume "a11 * fst x' + a12 * snd x' = b1  a21 * fst x' + a22 * snd x' = b2"
  with a11 * fst ?x + a12 * snd ?x = b1  a21 * fst ?x + a22 * snd ?x = b2
  have "a11 * (fst x' - fst ?x) + a12 * (snd x' - snd ?x) = 0  a21 * (fst x' - fst ?x) + a22 * (snd x' - snd ?x) = 0"
    by (auto simp add: field_simps)
  thus "x' = ?x"
    using regular_homogenous_system[OF assms, of "fst x' - fst ?x" "snd x' - snd ?x"]
    by (cases x') auto
qed

text ‹Singular system does not have a unique solution›
lemma singular_system:
  fixes a11 a12 a21 a22 ::"'a::field"
  assumes "det2 a11 a12 a21 a22 = 0" and "a11  0  a12  0"
  assumes x0: "a11*fst x0 + a12*snd x0 = b1"
              "a21*fst x0 + a22*snd x0 = b2"
  assumes x: "a11*fst x + a12*snd x = b1"
  shows "a21*fst x + a22*snd x = b2"
proof (cases "a11 = 0")
  case True
  with assms have "a21 = 0" "a12  0"
    by auto
  let ?k = "a22 / a12"
  have "b2 = ?k * b1"
    using x0 a11 = 0 a21 = 0 a12  0
    by auto
  thus ?thesis
    using a11 = 0 a21 = 0 a12  0 x
    by auto
next
  case False
  let ?k = "a21 / a11"
  from x
  have "?k * a11 * fst x + ?k * a12 * snd x = ?k * b1"
    using a11  0
    by (auto simp add: field_simps)
  moreover
  have "a21 = ?k * a11" "a22 = ?k * a12" "b2 = ?k * b1"
    using assms(1) x0 a11  0
    by (auto simp add: field_simps)
  ultimately
  show ?thesis
    by auto
qed

text ‹All solutions of a homogenous system of 2 equations with 3 unknows are proportional›
lemma linear_system_homogenous_3_2:
  fixes a11 a12 a13 a21 a22 a23 x1 y1 z1 x2 y2 z2 :: "'a::field"
  assumes "f1 = (λ x y z. a11 * x + a12 * y + a13 * z)"
  assumes "f2 = (λ x y z. a21 * x + a22 * y + a23 * z)"
  assumes "f1 x1 y1 z1 = 0" and "f2 x1 y1 z1 = 0"
  assumes "f1 x2 y2 z2 = 0" and "f2 x2 y2 z2 = 0"
  assumes "x2  0  y2  0  z2  0"
  assumes "det2 a11 a12 a21 a22  0  det2 a11 a13 a21 a23  0  det2 a12 a13 a22 a23  0"
  shows " k. x1 = k * x2  y1 = k * y2  z1 = k * z2"
proof-
  let ?Dz = "det2 a11 a12 a21 a22"
  let ?Dy = "det2 a11 a13 a21 a23"
  let ?Dx = "det2 a12 a13 a22 a23"

  have "a21 * (f1 x1 y1 z1) - a11 * (f2 x1 y1 z1) = 0"
    using assms
    by simp
  hence yz1: "?Dz*y1 + ?Dy*z1 = 0"
    using assms
    by (simp add: field_simps)

  have "a21 * (f1 x2 y2 z2) - a11 * (f2 x2 y2 z2) = 0"
    using assms
    by simp
  hence yz2: "?Dz*y2 + ?Dy*z2 = 0"
    using assms
    by (simp add: field_simps)
                                     
  have "a22 * (f1 x1 y1 z1) - a12 * (f2 x1 y1 z1) = 0"
    using assms
    by simp                          
  hence xz1: "-?Dz*x1 + ?Dx*z1 = 0"
    using assms
    by (simp add: field_simps)

  have "a22 * (f1 x2 y2 z2) - a12 * (f2 x2 y2 z2) = 0"
    using assms
    by simp                          
  hence xz2: "-?Dz*x2 + ?Dx*z2 = 0"
    using assms
    by (simp add: field_simps)

  have "a23 * (f1 x1 y1 z1) - a13 * (f2 x1 y1 z1) = 0"
    using assms
    by simp                          
  hence xy1: "?Dy*x1 + ?Dx*y1 = 0"
    using assms
    by (simp add: field_simps)

  have "a23 * (f1 x2 y2 z2) - a13 * (f2 x2 y2 z2) = 0"
    using assms
    by simp                          
  hence xy2: "?Dy*x2 + ?Dx*y2 = 0"
    using assms
    by (simp add: field_simps)

  show ?thesis
    using ?Dz  0  ?Dy  0  ?Dx  0
  proof safe
    assume "?Dz  0"
    
    hence *:
      "x2 = (?Dx / ?Dz) * z2" "y2 = - (?Dy / ?Dz) * z2"
      "x1 = (?Dx / ?Dz) * z1" "y1 = - (?Dy / ?Dz) * z1"
      using xy2 xz2 xy1 xz1 yz1 yz2
      by (simp_all add: field_simps)     

    hence "z2  0"
      using x2  0  y2  0  z2  0
      by auto

    thus ?thesis
      using * ?Dz  0
      by (rule_tac x="z1/z2" in exI) auto
  next
    assume "?Dy  0"
    hence *:
      "x2 = - (?Dx / ?Dy) * y2" "z2 = - (?Dz / ?Dy) * y2"
      "x1 = - (?Dx / ?Dy) * y1" "z1 = - (?Dz / ?Dy) * y1"
      using xy2 xz2 xy1 xz1 yz1 yz2
      by (simp_all add: field_simps)     

    hence "y2  0"
      using x2  0  y2  0  z2  0
      by auto

    thus ?thesis
      using * ?Dy  0
      by (rule_tac x="y1/y2" in exI) auto
  next
    assume "?Dx  0"
    hence *:
      "y2 = - (?Dy / ?Dx) * x2" "z2 = (?Dz / ?Dx) * x2"
      "y1 = - (?Dy / ?Dx) * x1" "z1 = (?Dz / ?Dx) * x1"
      using xy2 xz2 xy1 xz1 yz1 yz2
      by (simp_all add: field_simps)     

    hence "x2  0"
      using x2  0  y2  0  z2  0
      by auto

    thus ?thesis
      using * ?Dx  0
      by (rule_tac x="x1/x2" in exI) auto
  qed
qed

end

Theory Quadratic

(* ----------------------------------------------------------------- *)
subsection ‹Quadratic equations›
(* ----------------------------------------------------------------- *)

text ‹In this section some simple properties of quadratic equations and their roots are derived.
Quadratic equations over reals and over complex numbers, but also systems of quadratic equations and
systems of quadratic and linear equations are analysed.›

theory Quadratic
  imports More_Complex "HOL-Library.Quadratic_Discriminant"
begin

(* ----------------------------------------------------------------- *)
subsubsection ‹Real quadratic equations, Viette rules›
(* ----------------------------------------------------------------- *)

lemma viette2_monic:
  fixes b c ξ1 ξ2 :: real
  assumes "b2 - 4*c  0" and "ξ12 + b*ξ1 + c = 0" and "ξ22 + b*ξ2 + c = 0" and "ξ1  ξ2"
  shows "ξ1*ξ2 = c"
  using assms
  by algebra

lemma viette2:
  fixes a b c ξ1 ξ2 :: real
  assumes "a  0" and "b2 - 4*a*c  0" and "a*ξ12 + b*ξ1 + c = 0" and "a*ξ22 + b*ξ2 + c = 0" and "ξ1  ξ2"
  shows "ξ1*ξ2 = c/a"
proof (rule viette2_monic[of "b/a" "c/a" ξ1 ξ2])
  have "(b / a)2 - 4 * (c / a) = (b2 - 4*a*c) / a2"
    using a  0
    by (auto simp add: power2_eq_square field_simps)
  thus "0  (b / a)2 - 4 * (c / a)"
    using b2 - 4*a*c  0
    by simp
next
  show "ξ12 + b / a * ξ1 + c / a = 0" "ξ22 + b / a * ξ2 + c / a = 0"
    using assms
    by (auto simp add: power2_eq_square field_simps)
next
  show "ξ1  ξ2"
    by fact
qed

lemma viette2'_monic:
  fixes b c ξ :: real
  assumes "b2 - 4*c = 0" and "ξ2 + b*ξ + c = 0"
  shows "ξ*ξ = c"
  using assms
  by algebra

lemma viette2':
  fixes a b c ξ :: real
  assumes "a  0" and "b2 - 4*a*c = 0" and "a*ξ2 + b*ξ + c = 0"
  shows "ξ*ξ = c/a"
proof (rule viette2'_monic)
  have "(b / a)2 - 4 * (c / a) = (b2 - 4*a*c) / a2"
    using a  0
    by (auto simp add: power2_eq_square field_simps)
  thus "(b / a)2 - 4 * (c / a) = 0"
    using b2 - 4*a*c = 0
    by simp
next
  show "ξ2 + b / a * ξ + c / a = 0"
    using assms
    by (auto simp add: power2_eq_square field_simps)
qed

(* ----------------------------------------------------------------- *)
subsubsection ‹Complex quadratic equations›
(* ----------------------------------------------------------------- *)

lemma complex_quadratic_equation_monic_only_two_roots:
  fixes ξ :: complex
  assumes "ξ2 + b * ξ + c = 0"
  shows "ξ = (-b + ccsqrt(b2 - 4*c)) / 2  ξ = (-b - ccsqrt(b2 - 4*c)) / 2"
using assms
proof-
  from assms have "(2 * (ξ + b/2))2 = b2 - 4*c"
    by (simp add: power2_eq_square field_simps)
       (metis (no_types, lifting) distrib_right_numeral mult.assoc mult_zero_left)
  hence "2 * (ξ + b/2) = ccsqrt (b2 - 4*c)  2 * (ξ + b/2) = - ccsqrt (b2 - 4*c)"
    using ccsqrt[of "(2 * (ξ + b / 2))" "b2 - 4 * c"]
    by (simp add: power2_eq_square)
  thus ?thesis
    using mult_cancel_right[of "b + ξ * 2" 2 "ccsqrt (b2 - 4*c)"]
    using mult_cancel_right[of "b + ξ * 2" 2 "-ccsqrt (b2 - 4*c)"]
    by (auto simp add: field_simps) (metis add_diff_cancel diff_minus_eq_add minus_diff_eq)
qed

lemma complex_quadratic_equation_monic_roots:
  fixes ξ :: complex
  assumes "ξ = (-b + ccsqrt(b2 - 4*c)) / 2 
           ξ = (-b - ccsqrt(b2 - 4*c)) / 2"
  shows  "ξ2 + b * ξ + c = 0"
using assms
proof
  assume *: "ξ = (- b + ccsqrt (b2 - 4 * c)) / 2"
  show ?thesis
    by ((subst *)+) (subst power_divide, subst power2_sum, simp add: field_simps, simp add: power2_eq_square)
next
  assume *: "ξ = (- b - ccsqrt (b2 - 4 * c)) / 2"
  show ?thesis
    by ((subst *)+, subst power_divide, subst power2_diff, simp add: field_simps, simp add: power2_eq_square)
qed

lemma complex_quadratic_equation_monic_distinct_roots:
  fixes b c :: complex
  assumes "b2 - 4*c  0"
  shows " k1 k2. k1  k2  k12 + b*k1 + c = 0  k22 + b*k2 + c = 0"
proof-
  let ?ξ1 = "(-b + ccsqrt(b2 - 4*c)) / 2"
  let ?ξ2 = "(-b - ccsqrt(b2 - 4*c)) / 2"
  show ?thesis
    apply (rule_tac x="?ξ1" in exI)
    apply (rule_tac x="?ξ2" in exI)
    using assms 
    using complex_quadratic_equation_monic_roots[of ?ξ1 b c]
    using complex_quadratic_equation_monic_roots[of ?ξ2 b c]
    by simp
qed

lemma complex_quadratic_equation_two_roots:
  fixes ξ :: complex
  assumes "a  0" and "a*ξ2 + b * ξ + c = 0"
  shows "ξ = (-b + ccsqrt(b2 - 4*a*c)) / (2*a) 
         ξ = (-b - ccsqrt(b2 - 4*a*c)) / (2*a)"
proof-
  from assms have "ξ2 + (b/a) * ξ + (c/a) = 0"
    by (simp add: field_simps)
  hence "ξ = (-(b/a) + ccsqrt((b/a)2 - 4*(c/a))) / 2  ξ = (-(b/a) - ccsqrt((b/a)2 - 4*(c/a))) / 2"
    using complex_quadratic_equation_monic_only_two_roots[of ξ "b/a" "c/a"]
    by simp
  hence " k. ξ = (-(b/a) + (-1)^k * ccsqrt((b/a)2 - 4*(c/a))) / 2"
    by safe (rule_tac x="2" in exI, simp, rule_tac x="1" in exI, simp)
  then obtain k1 where "ξ = (-(b/a) + (-1)^k1 * ccsqrt((b/a)2 - 4*(c/a))) / 2"
    by auto
  moreover
  have "(b / a)2 - 4 * (c / a) = (b2 - 4 * a * c) * (1 / a2)"
    using a  0
    by (simp add: field_simps power2_eq_square)
  hence "ccsqrt ((b / a)2 - 4 * (c / a)) = ccsqrt (b2 - 4 * a * c) * ccsqrt (1/a2) 
         ccsqrt ((b / a)2 - 4 * (c / a)) = - ccsqrt (b2 - 4 * a * c) * ccsqrt (1/a2)"
    using ccsqrt_mult[of "b2 - 4 * a * c" "1/a2"]
    by auto
  hence " k.  ccsqrt ((b / a)2 - 4 * (c / a)) = (-1)^k * ccsqrt (b2 - 4 * a * c) * ccsqrt (1 / a2)"
    by safe (rule_tac x="2" in exI, simp, rule_tac x="1" in exI, simp)
  then obtain k2 where "ccsqrt ((b / a)2 - 4 * (c / a)) = (-1)^k2 * ccsqrt (b2 - 4 * a * c) * ccsqrt (1 / a2)"
    by auto
  moreover
  have "ccsqrt (1 / a2) = 1/a  ccsqrt (1 / a2) = -1/a"
    using ccsqrt[of "1/a" "1 / a2"]
    by (auto simp add: power2_eq_square)
  hence " k. ccsqrt (1 / a2) = (-1)^k * 1/a"
    by safe (rule_tac x="2" in exI, simp, rule_tac x="1" in exI, simp)
  then obtain k3 where "ccsqrt (1 / a2) = (-1)^k3 * 1/a"
    by auto
  ultimately
  have "ξ = (- (b / a) + ((-1) ^ k1 * (-1) ^ k2 * (-1) ^ k3) * ccsqrt (b2 - 4 * a * c) * 1/a) / 2"
    by simp
  moreover
  have "(-(1::complex)) ^ k1 * (-1) ^ k2 * (-1) ^ k3 = 1  (-(1::complex)) ^ k1 * (-1) ^ k2 * (-1) ^ k3 = -1"
    using neg_one_even_power[of "k1 + k2 + k3"]
    using neg_one_odd_power[of "k1 + k2 + k3"]
    by (smt power_add)
  ultimately
  have "ξ = (- (b / a) + ccsqrt (b2 - 4 * a * c) * 1 / a) / 2  ξ = (- (b / a) - ccsqrt (b2 - 4 * a * c) * 1 / a) / 2"
    by auto
  thus ?thesis
    using a  0
    by (simp add: field_simps)
qed

lemma complex_quadratic_equation_only_two_roots:
  fixes x :: complex
  assumes "a  0"
  assumes "qf = (λ x. a*x2 + b*x + c)"
          "qf x1 = 0" and "qf x2 = 0" and "x1  x2"
          "qf x = 0"
  shows "x = x1  x = x2"
  using assms
  using complex_quadratic_equation_two_roots
  by blast


(* ----------------------------------------------------------------- *)
subsubsection ‹Intersections of linear and quadratic forms›
(* ----------------------------------------------------------------- *)
(* These lemmas are not used *)

lemma quadratic_linear_at_most_2_intersections_help:
  fixes x y :: complex
  assumes "(a11, a12, a22)  (0, 0, 0)" and "k2  0"
          "qf = (λ x y. a11*x2 + 2*a12*x*y + a22*y2 + b1*x + b2*y + c)" and "lf = (λ x y. k1*x + k2*y + n)"
          "qf x y = 0" and "lf x y = 0"
          "pf = (λ x. (a11 - 2*a12*k1/k2 + a22*k12/k22)*x2 + (-2*a12*n/k2  + b1 + a22*2*n*k1/k22 - b2*k1/k2)*x + a22*n2/k22 - b2*n/k2 + c)"
          "yf = (λ x. (-n - k1*x) / k2)"
  shows "pf x = 0" and "y = yf x"
proof -
  show "y = yf x"
    using assms
    by (simp add:field_simps eq_neg_iff_add_eq_0)
next
  have "2*a12*x*(-n - k1*x)/k2 = (-2*a12*n/k2)*x - (2*a12*k1/k2)*x2"
    by algebra
  have "a22*((-n - k1*x)/k2)2 = a22*n2/k22 + (a22*2*n*k1/k22)*x + (a22*k12/k22)*x2"
    by (simp add: power_divide) algebra
  have "2*a12*x*(-n - k1*x)/k2 = (-2*a12*n/k2)*x - (2*a12*k1/k2)*x2"
    by algebra
  have "b2*(-n - k1*x)/k2 = -b2*n/k2 - (b2*k1/k2)*x"
    by algebra

  have *: "y = (-n - k1*x)/k2"
    using assms(2, 4, 6)
    by (simp add:field_simps eq_neg_iff_add_eq_0)

  have "0 = a11*x2 + 2*a12*x*y + a22*y2 + b1*x + b2*y + c"
    using assms
    by simp
  hence "0 = a11*x2 + 2*a12*x*(-n - k1*x)/k2 + a22*((-n - k1*x)/k2)2 + b1*x + b2*(-n - k1*x)/k2 + c"
    by (subst (asm) *, subst (asm) *, subst (asm) *) auto
  also have "... = (a11 - 2*a12*k1/k2 + a22*k12/k22)*x2 + (-2*a12*n/k2  + b1 + a22*2*n*k1/k22 - b2*k1/k2)*x + a22*n2/k22 -b2*n/k2 + c"
    using 2*a12*x*(-n - k1*x)/k2 = (-2*a12*n/k2)*x - (2*a12*k1/k2)*x2
    using a22*((-n - k1*x)/k2)2 = a22*n2/k22 + (a22*2*n*k1/k22)*x + (a22*k12/k22)*x2
    using b2*(-n - k1*x)/k2 = -b2*n/k2 - (b2*k1/k2)*x
    by (simp add:field_simps)
  finally show "pf x = 0"
    using assms(7)
    by auto
qed

lemma quadratic_linear_at_most_2_intersections_help':
  fixes x y :: complex
  assumes "qf = (λ x y. a11*x2 + 2*a12*x*y + a22*y2 + b1*x + b2*y + c)"
          "x = -n/k1" and "k1  0" and "qf x y = 0"
          "yf = (λ y. k12*a22*y2 + (-2*a12*n*k1 + b2*k12)*y + a11*n2 - b1*n*k1 + c*k12)"
  shows "yf y = 0"
proof-
  have "0 = a11*n2/k12 - 2*a12*n*y/k1 + a22*y2 - b1*n/k1 + b2*y + c"
    using assms(1, 2, 4)
    by (simp add: power_divide)
  hence "0 = a11*n2 - 2*a12*n*k1*y + a22*y2*k12 - b1*n*k1 + b2*y*k12 + c*k12"
    using assms(3)
    apply (simp add:field_simps power2_eq_square)
    by algebra
  thus ?thesis
    using assms(1, 4, 5)
    by (simp add:field_simps)
qed

lemma quadratic_linear_at_most_2_intersections:
  fixes x y x1 y1 x2 y2 :: complex
  assumes "(a11, a12, a22)  (0, 0, 0)" and "(k1, k2)  (0, 0)"
  assumes "a11*k22 - 2*a12*k1*k2 + a22*k12  0"
  assumes "qf = (λ x y. a11*x2 + 2*a12*x*y + a22*y2 + b1*x + b2*y + c)" and "lf = (λ x y. k1*x + k2*y + n)"
          "qf x1 y1 = 0" and "lf x1 y1 = 0"
          "qf x2 y2 = 0" and "lf x2 y2 = 0"
          "(x1, y1)  (x2, y2)"
          "qf x y = 0" and "lf x y = 0"
  shows "(x, y) = (x1, y1)  (x, y) = (x2, y2)"
proof(cases "k2 = 0")
  case True
  hence "k1  0"
    using assms(2)
    by simp

  have "a22*k12  0"
    using assms(3) True
    by auto

  have "x1 = -n/k1"
    using k1  0 assms(5, 7) True
    by (metis add.right_neutral add_eq_0_iff2 mult_zero_left nonzero_mult_div_cancel_left)
  have "x2 = -n/k1"
    using k1  0 assms(5, 9) True
    by (metis add.right_neutral add_eq_0_iff2 mult_zero_left nonzero_mult_div_cancel_left)
  have "x = -n/k1"
    using k1  0 assms(5, 12) True
    by (metis add.right_neutral add_eq_0_iff2 mult_zero_left nonzero_mult_div_cancel_left)

  let ?yf =  "(λ y. k12*a22*y2 + (-2*a12*n*k1 + b2*k12)*y + a11*n2 - b1*n*k1 + c*k12)"

  have "?yf y = 0"
    using quadratic_linear_at_most_2_intersections_help'[of qf a11 a12 a22 b1 b2 c x n k1 y ?yf]
    using assms(4, 11) k1  0 x = -n/k1
    by auto
  have "?yf y1 = 0"
    using quadratic_linear_at_most_2_intersections_help'[of qf a11 a12 a22 b1 b2 c x1 n k1 y1 ?yf]
    using assms(4, 6) k1  0 x1 = -n/k1
    by auto
  have "?yf y2 = 0"
    using quadratic_linear_at_most_2_intersections_help'[of qf a11 a12 a22 b1 b2 c x2 n k1 y2 ?yf]
    using assms(4, 8) k1  0 x2 = -n/k1
    by auto

  have "y1  y2"
    using assms(10) x1 = -n/k1 x2 = -n/k1
    by blast

  have "y = y1  y = y2"
    using complex_quadratic_equation_only_two_roots[of "a22*k12" ?yf "-2*a12*n*k1 + b2*k12" "a11*n2 - b1*n*k1 + c*k12"
                                                        y1 y2 y]
    using a22*k12  0 ?yf y1 = 0 y1  y2 ?yf y2 = 0 ?yf y = 0
    by fastforce

  thus ?thesis
    using x1 = -n/k1 x2 = -n/k1  x = -n/k1
    by auto
next
  case False

  let ?py = "(λ x. (-n - k1*x)/k2)"
  let ?pf = "(λ x. (a11 - 2*a12*k1/k2 + a22*k12/k22)*x2 + (-2*a12*n/k2  + b1 + a22*2*n*k1/k22 - b2*k1/k2)*x + a22*n2/k22 -b2*n/k2 + c)"
  have "?pf x1 = 0" "y1 = ?py x1"
    using quadratic_linear_at_most_2_intersections_help[of a11 a12 a22 k2 qf b1 b2 c lf k1 n x1 y1]
    using assms(1, 4, 5, 6, 7) False
    by auto
  have "?pf x2 = 0" "y2 = ?py x2"
    using quadratic_linear_at_most_2_intersections_help[of a11 a12 a22 k2 qf b1 b2 c lf k1 n x2 y2]
    using assms(1, 4, 5, 8, 9) False
    by auto
  have "?pf x = 0" "y = ?py x"
    using quadratic_linear_at_most_2_intersections_help[of a11 a12 a22 k2 qf b1 b2 c lf k1 n x y]
    using assms(1, 4, 5, 11, 12) False
    by auto

  have "x1  x2"
    using assms(10) y1 = ?py x1 y2 = ?py x2
    by auto

  have "a11 - 2*a12*k1/k2 + a22*k12/k22 = (a11 * k22 - 2 * a12 * k1 * k2 + a22 * k12)/k22"
    by (simp add: False power2_eq_square add_divide_distrib diff_divide_distrib)
  also have "...   0"
    using False assms(3)
    by simp
  finally have "a11 - 2*a12*k1/k2 + a22*k12/k22  0"
    .

  have "x = x1  x = x2"
    using complex_quadratic_equation_only_two_roots[of "a11 - 2*a12*k1/k2 + a22*k12/k22" ?pf
                                                       "(- 2 * a12 * n / k2 + b1 + a22 * 2 * n * k1 / k22 - b2 * k1 / k2)"
                                                       "a22 * n2 / k22 - b2 * n / k2 + c" x1 x2 x]
    using ?pf x2 = 0 ?pf x1 = 0 ?pf x = 0
    using a11 - 2 * a12 * k1 / k2 + a22 * k12 / k22  0
    using x1  x2
    by fastforce

  thus ?thesis
    using y = ?py x y1 = ?py x1 y2 = ?py x2
    by (cases "x = x1", auto)
qed

lemma quadratic_quadratic_at_most_2_intersections':
  fixes x y x1 y1 x2 y2 :: complex
  assumes "b2  B2  b1  B1"
          "(b2 - B2)2 + (b1 - B1)2  0"
  assumes "qf1 = (λ x y. x2 + y2 + b1*x + b2*y + c)"
          "qf2 = (λ x y. x2 + y2 + B1*x + B2*y + C)"
          "qf1 x1 y1 = 0" "qf2 x1 y1 = 0"
          "qf1 x2 y2 = 0" "qf2 x2 y2 = 0"
          "(x1, y1)  (x2, y2)"
          "qf1 x y = 0" "qf2 x y = 0"
  shows "(x, y) = (x1, y1)  (x, y) = (x2, y2)"
proof-
  have "x2 + y2 + b1*x + b2*y + c = 0"
    using assms by auto
  have "x2 + y2 + B1*x + B2*y + C = 0"
    using assms by auto
  hence "0 = x2 + y2 + b1*x + b2*y + c - (x2 + y2 + B1*x + B2*y + C)"
    using x2 + y2 + b1*x + b2*y + c = 0
    by auto
  hence "0 = (b1 - B1)*x + (b2 - B2)*y + c - C"
    by (simp  add:field_simps) 
  
  have "x12 + y12 + b1*x1 + b2*y1 + c = 0"
    using assms  by auto
  have "x12 + y12 + B1*x1 + B2*y1 + C = 0"
    using assms by auto
  hence "0 = x12 + y12 + b1*x1 + b2*y1 + c - (x12 + y12 + B1*x1 + B2*y1 + C)"
    using x12 + y12 + b1*x1 + b2*y1 + c = 0
    by auto
  hence "0 = (b1 - B1)*x1 + (b2 - B2)*y1 + c - C"
    by (simp  add:field_simps) 

  have "x22 + y22 + b1*x2 + b2*y2 + c = 0"
    using assms  by auto
  have "x22 + y22 + B1*x2 + B2*y2 + C = 0"
    using assms  by auto
  hence "0 = x22 + y22 + b1*x2 + b2*y2 + c - (x22 + y22 + B1*x2 + B2*y2 + C)"
    using x22 + y22 + b1*x2 + b2*y2 + c = 0
    by auto
  hence "0 = (b1 - B1)*x2 + (b2 - B2)*y2 + c - C"
    by (simp  add:field_simps)  

  have "(b1 - B1, b2 - B2)  (0, 0)"
    using assms(1) by auto

  let ?lf = "(λ x y. (b1 - B1)*x + (b2 - B2)*y + c - C)"

  have "?lf x y = 0" "?lf x1 y1 = 0" "?lf x2 y2 = 0"
    using 0 = (b1 - B1)*x2 + (b2 - B2)*y2 + c - C
          0 = (b1 - B1)*x1 + (b2 - B2)*y1 + c - C
          0 = (b1 - B1)*x + (b2 - B2)*y + c - C
    by auto

  thus ?thesis
    using quadratic_linear_at_most_2_intersections[of 1 0 1 "b1 - B1" "b2 - B2" qf1 b1 b2 c ?lf "c - C" x1 y1 x2 y2 x y]
    using (b1 - B1, b2 - B2)  (0, 0)
    using assms (b1 - B1, b2 - B2)  (0, 0)
    using (b1 - B1) * x + (b2 - B2) * y + c - C = 0 (b1 - B1) * x1 + (b2 - B2) * y1 + c - C = 0
    by (simp add: add_diff_eq)
qed

lemma quadratic_change_coefficients:
  fixes x y :: complex
  assumes "A1  0" 
  assumes "qf = (λ x y. A1*x2 + A1*y2 + b1*x + b2*y + c)"
          "qf x y = 0"
          "qf_1 = (λ x y. x2 + y2 + (b1/A1)*x + (b2/A1)*y + c/A1)"
  shows "qf_1 x y = 0"
proof-
  have "0 = A1*x2 + A1*y2 + b1*x + b2*y + c"
    using assms by auto
  hence "0/A1 = (A1*x2 + A1*y2 + b1*x + b2*y + c)/A1"
    using assms(1) by auto
  also have "... = A1*x2/A1 + A1*y2/A1 + b1*x/A1 + b2*y/A1 + c/A1"
    by (simp add: add_divide_distrib)
  also have "... = x2 + y2 + (b1/A1)*x + (b2/A1)*y + c/A1"
    using assms(1)
    by (simp add:field_simps)
  finally have "0 = x2 + y2 + (b1/A1)*x + (b2/A1)*y + c/A1"
    by simp
  thus ?thesis
    using assms
    by simp
qed

lemma quadratic_quadratic_at_most_2_intersections:
  fixes x y x1 y1 x2 y2 :: complex
  assumes "A1  0" and "A2  0"
  assumes "qf1 = (λ x y. A1*x2 + A1*y2 + b1*x + b2*y + c)" and
          "qf2 = (λ x y. A2*x2 + A2*y2 + B1*x + B2*y + C)" and
          "qf1 x1 y1 = 0" and "qf2 x1 y1 = 0" and
          "qf1 x2 y2 = 0" and "qf2 x2 y2 = 0" and
          "(x1, y1)  (x2, y2)" and
          "qf1 x y = 0" and "qf2 x y = 0"
  assumes "(b2*A2 - B2*A1)2 + (b1*A2 - B1*A1)2  0" and
          "b2*A2  B2*A1  b1*A2  B1*A1"
  shows "(x, y) = (x1, y1)  (x, y) = (x2, y2)"
proof-
  have *: "b2 / A1  B2 / A2  b1 / A1  B1 / A2"
    using assms(1, 2) assms(13)
    by (simp add:field_simps)
  have **: "(b2 / A1 - B2 / A2)2 + (b1 / A1 - B1 / A2)2  0"
    using assms(1, 2) assms(12)
    by (simp add:field_simps)

  let ?qf_1 = "(λ x y. x2 + y2 + (b1/A1)*x + (b2/A1)*y + c/A1)"
  let ?qf_2 = "(λ x y. x2 + y2 + (B1/A2)*x + (B2/A2)*y + C/A2)"

  have "?qf_1 x1 y1 = 0" "?qf_1 x2 y2 = 0" "?qf_1 x y = 0"
       "?qf_2 x1 y1 = 0" "?qf_2 x2 y2 = 0" "?qf_2 x y = 0"
    using assms quadratic_change_coefficients[of A1 qf1 b1 b2 c x2 y2 ?qf_1]
          quadratic_change_coefficients[of A1 qf1 b1 b2 c x1 y1 ?qf_1]
          quadratic_change_coefficients[of A2 qf2 B1 B2 C x1 y1 ?qf_2]
          quadratic_change_coefficients[of A2 qf2 B1 B2 C x2 y2 ?qf_2]
          quadratic_change_coefficients[of A1 qf1 b1 b2 c x y ?qf_1]
          quadratic_change_coefficients[of A2 qf2 B1 B2 C x y ?qf_2]
    by auto

  thus ?thesis
    using quadratic_quadratic_at_most_2_intersections'
              [of "b2 / A1" "B2 / A2" "b1 / A1" "B1 / A2" ?qf_1 "c / A1" ?qf_2 "C / A2" x1 y1 x2 y2 x y]
    using * ** (x1, y1)  (x2, y2)
    by fastforce
qed

end

Theory Matrices

(* ---------------------------------------------------------------------------- *)
subsection ‹Vectors and Matrices in $\mathbb{C}^2$›
(* ---------------------------------------------------------------------------- *)

text ‹Representing vectors and matrices of arbitrary dimensions pose a challenge in formal theorem
proving \cite{harrison05}, but we only need to consider finite dimension spaces $\mathbb{C}^2$ and
$\mathbb{R}^3$.›

theory Matrices
imports More_Complex Linear_Systems Quadratic
begin

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Vectors in $\mathbb{C}^2$›
(* ---------------------------------------------------------------------------- *)

text ‹Type of complex vector›

type_synonym complex_vec = "complex × complex"

definition vec_zero :: "complex_vec" where
  [simp]: "vec_zero = (0, 0)"

text ‹Vector scalar multiplication›

fun mult_sv :: "complex  complex_vec  complex_vec" (infixl "*sv" 100) where
  "k *sv (x, y) = (k*x, k*y)"

lemma fst_mult_sv [simp]: 
  shows "fst (k *sv v) = k * fst v"
  by (cases v) simp

lemma snd_mult_sv [simp]:
  shows "snd (k *sv v) = k * snd v"
  by (cases v) simp

lemma mult_sv_mult_sv [simp]: 
  shows "k1 *sv (k2 *sv v) = (k1*k2) *sv v"
  by (cases v) simp

lemma one_mult_sv [simp]:
  shows "1 *sv v =  v"
  by (cases v) simp

lemma mult_sv_ex_id1 [simp]:
  shows " k::complex. k  0  k *sv v = v"
  by (rule_tac x=1 in exI, simp)

lemma mult_sv_ex_id2 [simp]:
  shows " k::complex. k  0  v = k *sv v"
  by (rule_tac x=1 in exI, simp)

text ‹Scalar product of two vectors›

fun mult_vv :: "complex × complex  complex × complex  complex" (infixl "*vv" 100) where
 "(x, y) *vv (a, b) = x*a + y*b"

lemma mult_vv_commute:
  shows "v1 *vv v2 = v2 *vv v1"
  by (cases v1, cases v2) auto

lemma mult_vv_scale_sv1:
  shows "(k *sv v1) *vv v2 = k * (v1 *vv v2)"
  by (cases v1, cases v2) (auto simp add: field_simps)

lemma mult_vv_scale_sv2:
  shows "v1 *vv (k *sv v2) = k * (v1 *vv v2)"
  by (cases v1, cases v2) (auto simp add: field_simps)

text ‹Conjugate vector›

fun vec_map where
 "vec_map f (x, y) = (f x, f y)"

definition vec_cnj where
  "vec_cnj = vec_map cnj"

lemma vec_cnj_vec_cnj [simp]:
  shows "vec_cnj (vec_cnj v) = v"
  by (cases v) (simp add: vec_cnj_def)

lemma cnj_mult_vv:
  shows "cnj (v1 *vv v2) = (vec_cnj v1) *vv (vec_cnj v2)"
  by (cases v1, cases v2) (simp add: vec_cnj_def)

lemma vec_cnj_sv [simp]:
  shows "vec_cnj (k *sv A) = cnj k *sv vec_cnj A"
  by (cases A) (auto simp add: vec_cnj_def)

lemma scalsquare_vv_zero:
  shows "(vec_cnj v) *vv v = 0  v = vec_zero"
  apply (cases v)
  apply (auto simp add: vec_cnj_def field_simps complex_mult_cnj_cmod power2_eq_square)
  apply (metis (no_types) norm_eq_zero of_real_0 of_real_add of_real_eq_iff of_real_mult sum_squares_eq_zero_iff)+
  done

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Matrices in $\mathbb{C}^2$›
(* ---------------------------------------------------------------------------- *)

text ‹Type of complex matrices›

type_synonym complex_mat = "complex × complex × complex × complex"

text ‹Matrix scalar multiplication›

fun mult_sm :: "complex  complex_mat  complex_mat" (infixl "*sm" 100) where
  "k *sm (a, b, c, d) = (k*a, k*b, k*c, k*d)"

lemma mult_sm_distribution [simp]:
  shows "k1 *sm (k2 *sm A) = (k1*k2) *sm A"
  by (cases A) auto

lemma mult_sm_neutral [simp]:
  shows "1 *sm A = A"
  by (cases A) auto

lemma mult_sm_inv_l:
  assumes "k  0" and "k *sm A = B"
  shows "A = (1/k) *sm B"
  using assms
  by auto

lemma mult_sm_ex_id1 [simp]:
  shows " k::complex. k  0  k *sm M = M"
  by (rule_tac x=1 in exI, simp)

lemma mult_sm_ex_id2 [simp]:
  shows " k::complex. k  0  M = k *sm M"
  by (rule_tac x=1 in exI, simp)

text ‹Matrix addition and subtraction›

definition mat_zero :: "complex_mat" where [simp]: "mat_zero = (0, 0, 0, 0)"

fun mat_plus :: "complex_mat  complex_mat  complex_mat" (infixl "+mm" 100) where
  "mat_plus (a1, b1, c1, d1) (a2, b2, c2, d2) = (a1+a2, b1+b2, c1+c2, d1+d2)"

fun mat_minus :: "complex_mat  complex_mat  complex_mat" (infixl "-mm" 100) where
  "mat_minus (a1, b1, c1, d1) (a2, b2, c2, d2) = (a1-a2, b1-b2, c1-c2, d1-d2)"

fun mat_uminus :: "complex_mat  complex_mat" where
  "mat_uminus (a, b, c, d) = (-a, -b, -c, -d)"

lemma nonzero_mult_real:
  assumes "A  mat_zero" and "k  0"
  shows "k *sm A  mat_zero"
  using assms
  by (cases A) simp

text ‹Matrix multiplication.›

fun mult_mm :: "complex_mat  complex_mat  complex_mat" (infixl "*mm" 100) where
  "(a1, b1, c1, d1) *mm (a2, b2, c2, d2) =
   (a1*a2 + b1*c2, a1*b2 + b1*d2, c1*a2+d1*c2, c1*b2+d1*d2)"

lemma mult_mm_assoc:
  shows "A *mm (B *mm C) = (A *mm B) *mm C"
  by (cases A, cases B, cases C) (auto simp add: field_simps)

lemma mult_assoc_5:
  shows "A *mm (B *mm C *mm D) *mm E = (A *mm B) *mm C *mm (D *mm E)"
  by (simp only: mult_mm_assoc)

lemma mat_zero_r [simp]:
  shows "A *mm mat_zero = mat_zero"
  by (cases A) simp

lemma mat_zero_l [simp]:
  shows "mat_zero *mm A = mat_zero"
  by (cases A) simp

definition eye :: "complex_mat" where
  [simp]: "eye = (1, 0, 0, 1)"

lemma mat_eye_l:
  shows "eye *mm A = A"
  by (cases A) auto

lemma mat_eye_r:
  shows "A *mm eye = A"
  by (cases A) auto

lemma mult_mm_sm [simp]:
  shows "A *mm (k *sm B) = k *sm (A *mm B)"
  by (cases A, cases B) (simp add: field_simps)

lemma mult_sm_mm [simp]:
  shows "(k *sm A) *mm B = k *sm (A *mm B)"
  by (cases A, cases B) (simp add: field_simps)

lemma mult_sm_eye_mm [simp]:
  shows "k *sm eye *mm A = k *sm A"
  by (cases A) simp

text ‹Matrix determinant›

fun mat_det where "mat_det (a, b, c, d) = a*d - b*c"

lemma mat_det_mult [simp]:
  shows "mat_det (A *mm B) = mat_det A * mat_det B"
  by (cases A, cases B) (auto simp add: field_simps)

lemma mat_det_mult_sm [simp]:
  shows "mat_det (k *sm A) = (k*k) * mat_det A"
  by (cases A) (auto simp add: field_simps)

text ‹Matrix inverse›

fun mat_inv :: "complex_mat  complex_mat" where
  "mat_inv (a, b, c, d) = (1/(a*d - b*c)) *sm (d, -b, -c, a)"

lemma mat_inv_r:
  assumes "mat_det A  0"
  shows "A *mm (mat_inv A) = eye"
  using assms
proof (cases A, auto simp add: field_simps)
  fix a b c d :: complex
  assume "a * (a * (d * d)) + b * (b * (c * c)) = a * (b * (c * (d * 2)))"
  hence "(a*d - b*c)*(a*d - b*c) = 0"
    by (auto simp add: field_simps)
  hence *: "a*d - b*c = 0"
    by auto
  assume "a*d  b*c"
  with * show False
    by auto
qed

lemma mat_inv_l:
  assumes "mat_det A  0"
  shows "(mat_inv A) *mm A  = eye"
  using assms
proof (cases A, auto simp add: field_simps)
  fix a b c d :: complex
  assume "a * (a * (d * d)) + b * (b * (c * c)) = a * (b * (c * (d * 2)))"
  hence "(a*d - b*c)*(a*d - b*c) = 0"
    by (auto simp add: field_simps)
  hence *: "a*d - b*c = 0"
    by auto
  assume "a*d  b*c"
  with * show False
    by auto
qed

lemma mat_det_inv:
  assumes "mat_det A  0"
  shows "mat_det (mat_inv A) = 1 / mat_det A"
proof-
  have "mat_det eye = mat_det A * mat_det (mat_inv A)"
    using mat_inv_l[OF assms, symmetric]
    by simp
  thus ?thesis
    using assms
    by (simp add: field_simps)
qed

lemma mult_mm_inv_l:
  assumes "mat_det A  0" and "A *mm B = C"
  shows "B = mat_inv A *mm C"
  using assms mat_eye_l[of B]
  by (auto simp add: mult_mm_assoc mat_inv_l)

lemma mult_mm_inv_r:
  assumes "mat_det B  0" and "A *mm B = C"
  shows "A = C *mm mat_inv B"
  using assms mat_eye_r[of A]
  by (auto simp add: mult_mm_assoc[symmetric] mat_inv_r)

lemma mult_mm_non_zero_l:
  assumes "mat_det A  0" and "B  mat_zero"
  shows "A *mm B  mat_zero"
  using assms mat_zero_r
  using mult_mm_inv_l[OF assms(1), of B mat_zero]
  by auto

lemma mat_inv_mult_mm:
  assumes "mat_det A  0" and "mat_det B  0"
  shows "mat_inv (A *mm B) = mat_inv B *mm mat_inv A"
  using assms
proof-
  have "(A *mm B) *mm (mat_inv B *mm mat_inv A) = eye"
    using assms
    by (metis mat_inv_r mult_mm_assoc mult_mm_inv_r)
  thus ?thesis
    using mult_mm_inv_l[of "A *mm B" "mat_inv B *mm mat_inv A" eye] assms mat_eye_r
    by simp
qed

lemma mult_mm_cancel_l:
  assumes "mat_det M  0"  "M *mm A = M *mm B"
  shows "A = B"
  using assms
  by (metis mult_mm_inv_l)

lemma mult_mm_cancel_r:
  assumes "mat_det M  0"  "A *mm M = B *mm M"
  shows "A = B"
  using assms
  by (metis mult_mm_inv_r)

lemma mult_mm_non_zero_r:
  assumes "A  mat_zero" and "mat_det B  0"
  shows "A *mm B  mat_zero"
  using assms mat_zero_l
  using mult_mm_inv_r[OF assms(2), of A mat_zero]
  by auto

lemma mat_inv_mult_sm:
  assumes "k  0"
  shows "mat_inv (k *sm A) = (1 / k) *sm mat_inv A"
proof-
  obtain a b c d where "A = (a, b, c, d)"
    by (cases A) auto
  thus ?thesis
    using assms
    by auto (subst mult.assoc[of k a "k*d"], subst mult.assoc[of k b "k*c"], subst right_diff_distrib[of k "a*(k*d)" "b*(k*c)", symmetric], simp, simp add: field_simps)+
qed

lemma mat_inv_inv [simp]:
  assumes "mat_det M  0"
  shows "mat_inv (mat_inv M) = M"
proof-
  have "mat_inv M *mm M = eye"
    using mat_inv_l[OF assms]
    by simp
  thus ?thesis
    using assms mat_det_inv[of M]
    using mult_mm_inv_l[of "mat_inv M" M eye] mat_eye_r
    by (auto simp del: eye_def)
qed

text ‹Matrix transpose›

fun mat_transpose where
  "mat_transpose (a, b, c, d) = (a, c, b, d)"

lemma mat_t_mat_t [simp]:
  shows "mat_transpose (mat_transpose A) = A"
  by (cases A) auto

lemma mat_t_mult_sm [simp]:
  shows "mat_transpose (k *sm A) = k *sm (mat_transpose A)"
  by (cases A) simp

lemma mat_t_mult_mm [simp]:
  shows "mat_transpose (A *mm B) = mat_transpose B *mm mat_transpose A"
  by (cases A, cases B) auto

lemma mat_inv_transpose:
  shows "mat_transpose (mat_inv M) = mat_inv (mat_transpose M)"
  by (cases M) auto

lemma mat_det_transpose [simp]:
  fixes M :: "complex_mat"
  shows "mat_det (mat_transpose M) = mat_det M"
  by (cases M) auto

text ‹Diagonal matrices definition›

fun mat_diagonal where
 "mat_diagonal (A, B, C, D) = (B = 0  C = 0)"

text ‹Matrix conjugate›

fun mat_map where
 "mat_map f (a, b, c, d) = (f a, f b, f c, f d)"

definition mat_cnj where
  "mat_cnj = mat_map cnj"

lemma mat_cnj_cnj [simp]:
  shows "mat_cnj (mat_cnj A) = A"
  unfolding mat_cnj_def
  by (cases A) auto

lemma mat_cnj_sm [simp]:
  shows "mat_cnj (k *sm A) = cnj k *sm (mat_cnj A)"
  by (cases A) (simp add: mat_cnj_def)

lemma mat_det_cnj [simp]: 
  shows "mat_det (mat_cnj A) = cnj (mat_det A)"
  by (cases A) (simp add: mat_cnj_def)

lemma nonzero_mat_cnj:
  shows "mat_cnj A = mat_zero  A = mat_zero"
  by (cases A) (auto simp add: mat_cnj_def)

lemma mat_inv_cnj:
  shows "mat_cnj (mat_inv M) = mat_inv (mat_cnj M)"
  unfolding mat_cnj_def
  by (cases M) auto

text ‹Matrix adjoint - the conjugate traspose matrix ($A^* = \overline{A^t}$)›

definition mat_adj where
  "mat_adj A = mat_cnj (mat_transpose A)"

lemma mat_adj_mult_mm [simp]:
  shows "mat_adj (A *mm B) = mat_adj B *mm mat_adj A"
  by (cases A, cases B) (auto simp add: mat_adj_def mat_cnj_def)

lemma mat_adj_mult_sm [simp]:
  shows "mat_adj (k *sm A) = cnj k *sm mat_adj A"
  by (cases A) (auto simp add: mat_adj_def mat_cnj_def)

lemma mat_det_adj: 
  shows "mat_det (mat_adj A) = cnj (mat_det A)"
  by (cases A) (auto simp add: mat_adj_def mat_cnj_def)

lemma mat_adj_inv:
  assumes "mat_det M  0"
  shows "mat_adj (mat_inv M) = mat_inv (mat_adj M)"
  by (cases M) (auto simp add: mat_adj_def mat_cnj_def)

lemma mat_transpose_mat_cnj:
  shows "mat_transpose (mat_cnj A) = mat_adj A"
  by (cases A)  (auto simp add: mat_adj_def mat_cnj_def)

lemma mat_adj_adj [simp]:
  shows "mat_adj (mat_adj A) = A"
  unfolding mat_adj_def
  by (subst mat_transpose_mat_cnj) (simp add: mat_adj_def)

lemma mat_adj_eye [simp]:
  shows "mat_adj eye = eye"
  by (auto simp add: mat_adj_def mat_cnj_def)

text ‹Matrix trace›

fun mat_trace where
  "mat_trace (a, b, c, d) = a + d"

text ‹Multiplication of matrix and a vector›

fun mult_mv :: "complex_mat  complex_vec  complex_vec" (infixl "*mv" 100)  where
  "(a, b, c, d) *mv (x, y) = (x*a + y*b, x*c + y*d)"

fun mult_vm :: "complex_vec  complex_mat  complex_vec" (infixl "*vm" 100) where
  "(x, y) *vm (a, b, c, d)  = (x*a + y*c, x*b + y*d)"

lemma eye_mv_l [simp]:
  shows "eye *mv v = v"
  by (cases v) simp

lemma mult_mv_mv [simp]: 
  shows "B *mv (A *mv v) = (B *mm A) *mv v"
  by (cases v, cases A, cases B) (auto simp add: field_simps)

lemma mult_vm_vm [simp]:
  shows "(v *vm A) *vm B = v *vm (A *mm B)"
  by (cases v, cases A, cases B) (auto simp add: field_simps)

lemma mult_mv_inv:
  assumes "x =  A *mv y" and "mat_det A  0"
  shows "y = (mat_inv A) *mv x"
  using assms
  by (cases y) (simp add: mat_inv_l)

lemma mult_vm_inv:
  assumes "x =  y *vm A" and "mat_det A  0"
  shows "y = x *vm (mat_inv A) "
  using assms
  by (cases y) (simp add: mat_inv_r)

lemma mult_mv_cancel_l:
  assumes "mat_det A  0" and "A *mv v = A *mv v'"
  shows "v = v'"
  using assms
  using mult_mv_inv
  by blast

lemma mult_vm_cancel_r:
  assumes "mat_det A  0" and "v *vm A = v' *vm A"
  shows "v = v'"
  using assms
  using mult_vm_inv
  by blast

lemma vec_zero_l [simp]:
  shows "A *mv vec_zero = vec_zero"
  by (cases A) simp

lemma vec_zero_r [simp]:
  shows "vec_zero *vm A = vec_zero"
  by (cases A) simp

lemma mult_mv_nonzero:
  assumes "v  vec_zero" and "mat_det A  0"
  shows "A *mv v  vec_zero"
  apply (rule ccontr)
  using assms mult_mv_inv[of vec_zero A v] mat_inv_l vec_zero_l
  by auto

lemma mult_vm_nonzero:
  assumes "v  vec_zero" and "mat_det A  0"
  shows "v *vm A  vec_zero"
  apply (rule ccontr)
  using assms mult_vm_inv[of vec_zero v A] mat_inv_r vec_zero_r
  by auto

lemma mult_sv_mv:
  shows "k *sv (A *mv v) = (A *mv (k *sv v))"
  by (cases A, cases v) (simp add: field_simps)

lemma mult_mv_mult_vm: 
  shows "A *mv x = x *vm (mat_transpose A)"
  by (cases A, cases x) auto

lemma mult_mv_vv:
  shows "A *mv v1 *vv v2 = v1 *vv (mat_transpose A *mv v2)"
  by (cases v1, cases v2, cases A) (auto simp add: field_simps)

lemma mult_vv_mv:
  shows "x *vv (A *mv y)  = (x *vm A) *vv y"
  by (cases x, cases y, cases A) (auto simp add: field_simps)

lemma vec_cnj_mult_mv:
  shows "vec_cnj (A *mv x) =  (mat_cnj A) *mv (vec_cnj x)"
  by (cases A, cases x) (auto simp add: vec_cnj_def mat_cnj_def)

lemma vec_cnj_mult_vm:
  shows "vec_cnj (v *vm A) = vec_cnj v *vm mat_cnj A"
  unfolding vec_cnj_def mat_cnj_def
  by (cases A, cases v, auto)

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Eigenvalues and eigenvectors›
(* ---------------------------------------------------------------------------- *)

definition eigenpair where
  [simp]: "eigenpair k v H  v  vec_zero  H *mv v = k *sv v"

definition eigenval where
  [simp]: "eigenval k H  ( v. v  vec_zero  H *mv v = k *sv v)"

lemma eigen_equation:
  shows "eigenval k H  k2 - mat_trace H * k + mat_det H = 0" (is "?lhs  ?rhs")
proof-
  obtain A B C D where HH: "H = (A, B, C, D)"
    by (cases H) auto
  show ?thesis
  proof
    assume ?lhs
    then obtain v where "v  vec_zero" "H *mv v = k *sv v"
      unfolding eigenval_def
      by blast
    obtain v1 v2 where vv: "v = (v1, v2)"
      by (cases v) auto
    from H *mv v = k *sv v have "(H -mm (k *sm eye)) *mv v = vec_zero"
      using HH vv
      by (auto simp add: field_simps)
    hence "mat_det (H -mm (k *sm eye)) = 0"
      using v  vec_zero› vv HH
      using regular_homogenous_system[of "A - k" B C "D - k" v1 v2]
      unfolding det2_def
      by (auto simp add: field_simps)
    thus ?rhs
      using HH
      by (auto simp add: power2_eq_square field_simps)
  next
    assume ?rhs
    hence *: "mat_det (H -mm (k *sm eye)) = 0"
      using HH
      by (auto simp add: field_simps power2_eq_square)
    show ?lhs
    proof (cases "H -mm (k *sm eye) = mat_zero")
      case True
      thus ?thesis
        using HH
        by (auto) (rule_tac x=1 in exI, simp)
    next
      case False
      hence "(A - k  0  B  0)  (D - k  0  C  0)"
        using HH
        by auto
      thus ?thesis
      proof
        assume "A - k  0  B  0"
        hence "C * B + (D - k) * (k - A) = 0"
          using * singular_system[of "A-k" "D-k" B C "(0, 0)" 0 0  "(B, k-A)"] HH
          by (auto simp add: field_simps)
        hence  "(B, k-A)  vec_zero" "(H -mm (k *sm eye)) *mv (B, k-A) = vec_zero"
          using HH A - k  0  B  0
          by (auto simp add: field_simps)
        then obtain v where "v  vec_zero  (H -mm (k *sm eye)) *mv v = vec_zero"
          by blast
        thus ?thesis
          using HH
          unfolding eigenval_def
          by (rule_tac x="v" in exI) (case_tac v, simp add: field_simps)
      next
        assume "D - k  0  C  0"
        hence "C * B + (D - k) * (k - A) = 0"
          using * singular_system[of "D-k" "A-k" C B "(0, 0)" 0 0  "(C, k-D)"] HH
          by (auto simp add: field_simps)
        hence  "(k-D, C)  vec_zero" "(H -mm (k *sm eye)) *mv (k-D, C) = vec_zero"
          using HH D - k  0  C  0
          by (auto simp add: field_simps)
        then obtain v where "v  vec_zero  (H -mm (k *sm eye)) *mv v = vec_zero"
          by blast
        thus ?thesis
          using HH
          unfolding eigenval_def
          by (rule_tac x="v" in exI) (case_tac v, simp add: field_simps)
      qed
    qed
  qed
qed

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Bilinear and Quadratic forms, Congruence, and Similarity›
(* ---------------------------------------------------------------------------- *)

text ‹Bilinear forms›

definition bilinear_form where
  [simp]: "bilinear_form v1 v2 H = (vec_cnj v1) *vm H *vv v2"

lemma bilinear_form_scale_m:
  shows "bilinear_form v1 v2 (k *sm H) = k * bilinear_form v1 v2 H"
  by (cases v1, cases v2, cases H) (simp add: vec_cnj_def field_simps)

lemma bilinear_form_scale_v1:
  shows "bilinear_form (k *sv v1) v2 H = cnj k * bilinear_form v1 v2 H"
  by (cases v1, cases v2, cases H) (simp add: vec_cnj_def field_simps)

lemma bilinear_form_scale_v2:
  shows "bilinear_form  v1 (k *sv v2) H = k * bilinear_form v1 v2 H"
  by (cases v1, cases v2, cases H) (simp add: vec_cnj_def field_simps)

text ‹Quadratic forms›

definition quad_form where
  [simp]: "quad_form v H = (vec_cnj v) *vm H *vv v"

lemma quad_form_bilinear_form: 
  shows "quad_form v H = bilinear_form v v H"
  by simp

lemma quad_form_scale_v:
  shows "quad_form (k *sv v) H = cor ((cmod k)2) * quad_form v H"
  using bilinear_form_scale_v1 bilinear_form_scale_v2
  by (simp add: complex_mult_cnj_cmod field_simps)

lemma quad_form_scale_m:
  shows "quad_form v (k *sm H) = k * quad_form v H"
  using bilinear_form_scale_m
  by simp

lemma cnj_quad_form [simp]:
  shows "cnj (quad_form z H) = quad_form z (mat_adj H)"
  by (cases H, cases z) (auto simp add: mat_adj_def mat_cnj_def vec_cnj_def field_simps)

text ‹Matrix congruence›

text ‹Two matrices are congruent iff they represent the same quadratic form with respect to different
bases (for example if one circline can be transformed to another by a Möbius trasformation).›

definition congruence where
  [simp]: "congruence M H  mat_adj M *mm H *mm M"

lemma congruence_nonzero:
  assumes "H  mat_zero" and "mat_det M  0"
  shows "congruence M H  mat_zero"
  using assms
  unfolding congruence_def
  by (subst mult_mm_non_zero_r, subst mult_mm_non_zero_l) (auto simp add: mat_det_adj)

lemma congruence_congruence:
  shows "congruence M1 (congruence M2 H) = congruence (M2 *mm M1) H"
  unfolding congruence_def
  apply (subst mult_mm_assoc)
  apply (subst mult_mm_assoc)
  apply (subst mat_adj_mult_mm)
  apply (subst mult_mm_assoc)
  by simp

lemma congruence_eye [simp]: 
  shows "congruence eye H = H"
  by (cases H) (simp add: mat_adj_def mat_cnj_def)

lemma congruence_congruence_inv [simp]:
  assumes "mat_det M  0"
  shows "congruence M (congruence (mat_inv M) H) = H"
  using assms congruence_congruence[of M "mat_inv M" H]
  using mat_inv_l[of M] mat_eye_l mat_eye_r
  unfolding congruence_def
  by (simp del: eye_def)

lemma congruence_inv:
  assumes "mat_det M  0" and "congruence M H = H'"
  shows "congruence (mat_inv M) H' = H"
  using assms
  using ‹mat_det M  0 mult_mm_inv_l[of "mat_adj M" "H *mm M" "H'"]
  using mult_mm_inv_r[of M "H" "mat_inv (mat_adj M) *mm H'"]
  by (simp add: mat_det_adj mult_mm_assoc mat_adj_inv)

lemma congruence_scale_m [simp]:
  shows "congruence M (k *sm H) = k *sm (congruence M H)"
  by (cases M, cases H) (auto simp add: mat_adj_def mat_cnj_def field_simps)

lemma inj_congruence:
  assumes "mat_det M  0" and "congruence M H = congruence M H'"
  shows "H = H'"
proof-
  have "H *mm M = H' *mm M "
    using assms
    using mult_mm_cancel_l[of "mat_adj M" "H *mm M" "H' *mm M"]
    by (simp add: mat_det_adj mult_mm_assoc)
  thus ?thesis
    using assms
    using mult_mm_cancel_r[of "M" "H" "H'"]
    by simp
qed

lemma mat_det_congruence [simp]:
  "mat_det (congruence M H) = (cor ((cmod (mat_det M))2)) * mat_det H"
  using complex_mult_cnj_cmod[of "mat_det M"]
  by (auto simp add: mat_det_adj field_simps)

lemma det_sgn_congruence [simp]:
  assumes "mat_det M  0"
  shows "sgn (mat_det (congruence M H)) = sgn (mat_det H)"
  using assms
  by (subst mat_det_congruence, auto simp add: sgn_mult power2_eq_square) (simp add: sgn_of_real)

lemma Re_det_sgn_congruence [simp]:
  assumes "mat_det M  0"
  shows "sgn (Re (mat_det (congruence M H))) = sgn (Re (mat_det H))"
proof-
  have *: "Re (mat_det (congruence M H)) = (cmod (mat_det M))2 * Re (mat_det H)"
    by (subst mat_det_congruence, subst Re_mult_real, rule Im_complex_of_real) (subst Re_complex_of_real, simp)
  show ?thesis
    using assms
    by (subst *) (auto simp add: sgn_mult)
qed

text ‹Transforming a matrix $H$ by a regular matrix $M$ preserves its bilinear and quadratic forms.›

lemma bilinear_form_congruence [simp]:
  assumes "mat_det M  0"
  shows "bilinear_form (M *mv v1) (M *mv v2) (congruence (mat_inv M) H) =
         bilinear_form v1 v2 H"
proof-
  have "mat_det (mat_adj M)  0"
    using assms
    by (simp add: mat_det_adj)
  show ?thesis
    unfolding bilinear_form_def congruence_def
    apply (subst mult_mv_mult_vm)
    apply (subst vec_cnj_mult_vm)
    apply (subst mat_adj_def[symmetric])
    apply (subst mult_vm_vm)
    apply (subst mult_vv_mv)
    apply (subst mult_vm_vm)
    apply (subst mat_adj_inv[OF ‹mat_det M  0])
    apply (subst mult_assoc_5)
    apply (subst mat_inv_r[OF ‹mat_det (mat_adj M)  0])
    apply (subst mat_inv_l[OF ‹mat_det M  0])
    apply (subst mat_eye_l, subst mat_eye_r)
    by simp
qed

lemma quad_form_congruence [simp]:
  assumes "mat_det M  0"
  shows "quad_form (M *mv z) (congruence (mat_inv M) H) = quad_form z H"
  using bilinear_form_congruence[OF assms]
  by simp


text ‹Similar matrices›

text ‹Two matrices are similar iff they represent the same linear operator with respect to (possibly)
different bases (e.g., if they represent the same Möbius transformation after changing the
coordinate system)›

definition similarity where
  "similarity A M = mat_inv A *mm M *mm A"

lemma mat_det_similarity [simp]:
  assumes "mat_det A  0"
  shows "mat_det (similarity A M) = mat_det M"
  using assms
  unfolding similarity_def
  by (simp add: mat_det_inv)

lemma mat_trace_similarity [simp]:
  assumes "mat_det A  0"
  shows "mat_trace (similarity A M) = mat_trace M"
proof-
  obtain a b c d where AA: "A = (a, b, c, d)"
    by (cases A) auto
  obtain mA mB mC mD where MM: "M = (mA, mB, mC, mD)"
    by (cases M) auto
  have "mA * (a * d) / (a * d - b * c) + mD * (a * d) / (a * d - b * c) =
        mA + mD + mA * (b * c) / (a * d - b * c) + mD * (b * c) / (a * d - b * c)"
    using assms AA
    by (simp add: field_simps)
  thus ?thesis
    using AA MM
    by (simp add: field_simps similarity_def)
qed

lemma similarity_eye [simp]:
  shows "similarity eye M = M"
  unfolding similarity_def
  using mat_eye_l mat_eye_r
  by auto


lemma similarity_eye' [simp]:
  shows "similarity (1, 0, 0, 1) M = M"
  unfolding eye_def[symmetric]
  by (simp del: eye_def)

lemma similarity_comp [simp]:
  assumes "mat_det A1  0" and "mat_det A2  0"
  shows "similarity A1 (similarity A2 M) = similarity (A2*mmA1) M"
  using assms
  unfolding similarity_def
  by (simp add: mult_mm_assoc mat_inv_mult_mm)

lemma similarity_inv:
  assumes "similarity A M1 = M2" and "mat_det A  0"
  shows "similarity (mat_inv A) M2 = M1"
  using assms
  unfolding similarity_def
  by (metis mat_det_mult mult_mm_assoc mult_mm_inv_l mult_mm_inv_r mult_zero_left)

end

Theory Unitary_Matrices

(* -------------------------------------------------------------------------- *)
subsection ‹Generalized Unitary Matrices›
(* -------------------------------------------------------------------------- *)

theory Unitary_Matrices
imports Matrices More_Complex
begin

text ‹In this section (generalized) $2\times 2$ unitary matrices are introduced.›

text ‹Unitary matrices›
definition unitary where
  "unitary M  mat_adj M *mm M = eye"

text ‹Generalized unitary matrices›
definition unitary_gen where
  "unitary_gen M 
   ( k::complex. k  0  mat_adj M *mm M = k *sm eye)"

text ‹Scalar can be always be a positive real›
lemma unitary_gen_real:
  assumes "unitary_gen M"
  shows "( k::real. k > 0  mat_adj M *mm M = cor k *sm eye)"
proof-
  obtain k where *: "mat_adj M *mm M = k *sm eye" "k  0"
    using assms
    by (auto simp add: unitary_gen_def)
  obtain a b c d where "M = (a, b, c, d)"
    by (cases M) auto
  hence "k = cor ((cmod a)2) + cor ((cmod c)2)"
    using *
    by (subst  complex_mult_cnj_cmod[symmetric])+ (auto simp add: mat_adj_def mat_cnj_def)
  hence "is_real k  Re k > 0"
    using k  0
    by (smt add_cancel_left_left arg_0_iff arg_complex_of_real_positive not_sum_power2_lt_zero of_real_0 plus_complex.simps(1) plus_complex.simps(2))
  thus ?thesis
    using *
    by (rule_tac x="Re k" in exI) simp
qed

text ‹Generalized unitary matrices can be factored into a product of a unitary matrix and a real
positive scalar multiple of the identity matrix›
lemma unitary_gen_unitary:
  shows "unitary_gen M 
         ( k M'. k > 0  unitary M'  M = (cor k *sm eye) *mm M')" (is "?lhs = ?rhs")
proof
  assume ?lhs
  then obtain k where *: "k>0" "mat_adj M *mm M = cor k *sm eye"
    using unitary_gen_real[of M]
    by auto

  let ?k' = "cor (sqrt k)"
  have "?k' * cnj ?k' = cor k"
    using k > 0
    by simp
  moreover
  have "Re ?k' > 0" "is_real ?k'" "?k'  0"
    using k > 0
    by auto
  ultimately
  show ?rhs
    using * mat_eye_l
    unfolding unitary_gen_def unitary_def
    by (rule_tac x="Re ?k'" in exI) (rule_tac x="(1/?k')*smM" in exI, simp add: mult_sm_mm[symmetric])
next
  assume ?rhs
  then obtain k M' where "k > 0" "unitary M'" "M = (cor k *sm eye) *mm M'"
    by blast
  hence "M = cor k *sm M'"
    using mult_sm_mm[of "cor k" eye M'] mat_eye_l
    by simp
  thus ?lhs
    using ‹unitary M' k > 0
    by (simp add: unitary_gen_def unitary_def)
qed

text ‹When they represent Möbius transformations, eneralized unitary matrices fix the imaginary unit circle. Therefore, they
fix a Hermitean form with (2, 0) signature (two positive and no negative diagonal elements).›
lemma unitary_gen_iff':
  shows "unitary_gen M  
         ( k::complex. k  0  congruence M (1, 0, 0, 1) = k *sm (1, 0, 0, 1))"
  unfolding unitary_gen_def
  using mat_eye_r
  by (auto simp add: mult.assoc)

text ‹Unitary matrices are special cases of general unitary matrices›
lemma unitary_unitary_gen [simp]:
  assumes "unitary M" 
  shows "unitary_gen M"
  using assms
  unfolding unitary_gen_def unitary_def
  by auto

text ‹Generalized unitary matrices are regular›
lemma unitary_gen_regular:
  assumes "unitary_gen M"
  shows "mat_det M  0"
proof-
  from assms obtain k where
    "k  0" "mat_adj M *mm M = k *sm eye"
    unfolding unitary_gen_def
    by auto
  hence "mat_det (mat_adj M *mm M)  0"
    by simp
  thus ?thesis
    by (simp add: mat_det_adj)
qed

lemmas unitary_regular = unitary_gen_regular[OF unitary_unitary_gen]

(* -------------------------------------------------------------------------- *)
subsubsection ‹Group properties›
(* -------------------------------------------------------------------------- *)

text ‹Generalized $2\times 2$ unitary matrices form a group under
multiplication (usually denoted by $GU(2, \mathbb{C})$). The group is closed
under non-zero complex scalar multiplication. Since these matrices are
always regular, they form a subgroup of general linear group (usually
denoted by $GL(2, \mathbb{C})$) of all regular matrices.›

lemma unitary_gen_scale [simp]:
  assumes "unitary_gen M" and "k  0"
  shows "unitary_gen (k *sm M)"
  using assms
  unfolding unitary_gen_def
  by auto

lemma unitary_comp:
  assumes "unitary M1" and "unitary M2"
  shows "unitary (M1 *mm M2)"
  using assms
  unfolding unitary_def
  by (metis mat_adj_mult_mm mat_eye_l mult_mm_assoc)

lemma unitary_gen_comp:
  assumes "unitary_gen M1" and "unitary_gen M2"
  shows "unitary_gen (M1 *mm M2)"
proof-
  obtain k1 k2 where *: "k1 * k2  0" "mat_adj M1 *mm M1 = k1 *sm eye" "mat_adj M2 *mm M2 = k2 *sm eye"
    using assms
    unfolding unitary_gen_def
    by auto
  have "mat_adj M2 *mm mat_adj M1 *mm (M1 *mm M2) = mat_adj M2 *mm (mat_adj M1 *mm M1) *mm M2"
    by (auto simp add: mult_mm_assoc)
  also have "... = mat_adj M2 *mm ((k1 *sm eye) *mm M2)"
    using *
    by (auto simp add: mult_mm_assoc)
  also have "... = mat_adj M2 *mm (k1 *sm M2)"
    using mult_sm_eye_mm[of k1 M2]
    by (simp del: eye_def)
  also have "... = k1 *sm (k2 *sm eye)"
    using *
    by auto
  finally
  show ?thesis
    using *
    unfolding unitary_gen_def
    by (rule_tac x="k1*k2" in exI, simp del: eye_def)
qed

lemma unitary_adj_eq_inv:
  shows "unitary M  mat_det M  0  mat_adj M = mat_inv M"
  using  unitary_regular[of M] mult_mm_inv_r[of M "mat_adj M" eye]  mat_eye_l[of "mat_inv M"] mat_inv_l[of M]
  unfolding unitary_def
  by - (rule, simp_all)

lemma unitary_inv:
  assumes "unitary M"
  shows "unitary (mat_inv M)"
  using assms
  unfolding unitary_adj_eq_inv
  using mat_adj_inv[of M] mat_det_inv[of M]
  by simp

lemma unitary_gen_inv:
  assumes "unitary_gen M"
  shows "unitary_gen (mat_inv M)"
proof-
    obtain k M' where "0 < k" "unitary M'" "M = cor k *sm eye *mm M'"
      using unitary_gen_unitary[of M] assms
      by blast
    hence "mat_inv M = cor (1/k) *sm mat_inv M'"
      by (metis mat_inv_mult_sm mult_sm_eye_mm norm_not_less_zero of_real_1 of_real_divide of_real_eq_0_iff sgn_1_neg sgn_greater sgn_if sgn_pos sgn_sgn)
    thus ?thesis
      using k > 0 ‹unitary M'
      by (subst unitary_gen_unitary[of "mat_inv M"]) (rule_tac x="1/k" in exI, rule_tac x="mat_inv M'" in exI, metis divide_pos_pos mult_sm_eye_mm unitary_inv zero_less_one)
  qed

(* -------------------------------------------------------------------------- *)
subsubsection ‹The characterization in terms of matrix elements›
(* -------------------------------------------------------------------------- *)

text ‹Special matrices are those having the determinant equal to 1. We first give their characterization.›
lemma unitary_special:
  assumes "unitary M" and "mat_det M = 1"
  shows " a b. M = (a, b, -cnj b, cnj a)"
proof-
  have "mat_adj M = mat_inv M"
    using assms mult_mm_inv_r[of M "mat_adj M" "eye"] mat_eye_r mat_eye_l
    by (simp add: unitary_def)
  thus ?thesis
    using ‹mat_det M = 1
    by (cases M) (auto simp add: mat_adj_def mat_cnj_def)
qed

lemma unitary_gen_special:
  assumes "unitary_gen M" and "mat_det M = 1"
  shows " a b. M = (a, b, -cnj b, cnj a)"
proof-
  from assms
  obtain k where *: "k  0" "mat_adj M *mm M = k *sm eye"
    unfolding unitary_gen_def
    by auto
  hence "mat_det (mat_adj M *mm M) = k*k"
    by simp
  hence "k*k = 1"
    using assms(2)
    by (simp add: mat_det_adj)
  hence "k = 1  k = -1"
    using square_eq_1_iff[of k]
    by simp
  moreover
  have "mat_adj M = k *sm mat_inv M"
    using *
    using assms mult_mm_inv_r[of M "mat_adj M" "k *sm eye"] mat_eye_r mat_eye_l
    by simp (metis mult_sm_eye_mm *(2))
  moreover
  obtain a b c d where "M = (a, b, c, d)"
    by (cases M) auto
  ultimately
  have "M = (a, b, -cnj b, cnj a)  M = (a, b, cnj b, -cnj a)"
    using assms(2)
    by (auto simp add: mat_adj_def mat_cnj_def)
  moreover
  have "Re (- (cor (cmod a))2 - (cor (cmod b))2) < 1"
    by (smt cmod_square complex_norm_square minus_complex.simps(1) of_real_power realpow_square_minus_le uminus_complex.simps(1))
  hence "- (cor (cmod a))2 - (cor (cmod b))2  1"
    by force
  hence "M  (a, b, cnj b, -cnj a)"
    using ‹mat_det M = 1 complex_mult_cnj_cmod[of a] complex_mult_cnj_cmod[of b]
    by auto
  ultimately
  show ?thesis
    by auto
qed

text ‹A characterization of all generalized unitary matrices›
lemma unitary_gen_iff:
  shows "unitary_gen M  
         ( a b k. k  0  mat_det (a, b, -cnj b, cnj a)  0 
                           M = k *sm (a, b, -cnj b, cnj a))" (is "?lhs = ?rhs")
proof
  assume ?lhs
  obtain d where *: "d*d = mat_det M"
    using ex_complex_sqrt
    by auto
  hence "d  0"
    using unitary_gen_regular[OF ‹unitary_gen M]
    by auto
  from ‹unitary_gen M
  obtain k where "k  0" "mat_adj M *mm M = k *sm eye"
    unfolding unitary_gen_def
    by auto
  hence "mat_adj ((1/d)*smM) *mm ((1/d)*smM) = (k / (d*cnj d)) *sm eye"
    by simp
  obtain a b where "(a, b, - cnj b, cnj a) = (1 / d) *sm M"
    using unitary_gen_special[of "(1 / d) *sm M"]  ‹unitary_gen M *  unitary_gen_regular[of M] d  0
    by force
  moreover
  hence "mat_det (a, b, - cnj b, cnj a)  0"
    using unitary_gen_regular[OF ‹unitary_gen M] d  0
    by auto
  ultimately
  show ?rhs
    apply (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="d" in exI)
    using mult_sm_inv_l[of "1/d" M]
    by (auto simp add: field_simps)
next
  assume ?rhs
  then obtain a b k where "k  0  mat_det (a, b, - cnj b, cnj a)  0  M = k *sm (a, b, - cnj b, cnj a)"
    by auto
  thus ?lhs
    unfolding unitary_gen_def
    apply (auto simp add: mat_adj_def mat_cnj_def)
    using mult_eq_0_iff[of "cnj k * k" "cnj a * a + cnj b * b"]
    by (auto simp add: field_simps)
qed

text ‹A characterization of unitary matrices›

lemma unitary_iff:
  shows "unitary M 
         ( a b k. (cmod a)2 + (cmod b)2  0  
                           (cmod k)2 = 1 / ((cmod a)2 + (cmod b)2) 
                           M = k *sm (a, b, -cnj b, cnj a))" (is "?lhs = ?rhs")
proof
  assume ?lhs
  obtain k a b where *: "M = k *sm (a, b, -cnj b, cnj a)" "k  0" "mat_det (a, b, -cnj b, cnj a)  0"
    using unitary_gen_iff  unitary_unitary_gen[OF ‹unitary M]
    by auto

  have md: "mat_det (a, b, -cnj b, cnj a) = cor ((cmod a)2 + (cmod b)2)"
    by (auto simp add: complex_mult_cnj_cmod)

  have "k * cnj k * mat_det (a, b, -cnj b, cnj a) = 1"
    using ‹unitary M *
    unfolding unitary_def
    by (auto simp add: mat_adj_def mat_cnj_def field_simps)
  hence "(cmod k)2 * ((cmod a)2 + (cmod b)2) = 1"
    by (metis (mono_tags, lifting) complex_norm_square md of_real_1 of_real_eq_iff of_real_mult)
  thus ?rhs
    using * mat_eye_l
    apply (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="k" in exI)
    apply (auto simp add: complex_mult_cnj_cmod)
    by (metis (cmod k)2 * ((cmod a)2 + (cmod b)2) = 1 mult_eq_0_iff nonzero_eq_divide_eq zero_neq_one)
next
  assume ?rhs
  then obtain a b k where  *: "(cmod a)2 + (cmod b)2  0" "(cmod k)2 = 1 / ((cmod a)2 + (cmod b)2)" "M = k *sm (a, b, -cnj b, cnj a)"
    by auto
  have "(k * cnj k) * (a * cnj a) + (k * cnj k) * (b * cnj b) = 1"
    apply (subst complex_mult_cnj_cmod)+
    using *(1-2)
    by (metis (no_types, lifting) distrib_left nonzero_eq_divide_eq of_real_1 of_real_add of_real_divide of_real_eq_0_iff)
  thus ?lhs
    using *
    unfolding unitary_def
    by (simp add: mat_adj_def mat_cnj_def field_simps)
qed

end

Theory Unitary11_Matrices

(* ----------------------------------------------------------------- *)
subsection ‹Generalized unitary matrices with signature $(1, 1)$›
(* ----------------------------------------------------------------- *)

theory Unitary11_Matrices
imports Matrices More_Complex
begin

text ‹ When acting as Möbius transformations in the extended
complex plane, generalized complex $2\times 2$ unitary matrices fix
the imaginary unit circle (a Hermitean form with (2, 0) signature). We
now describe matrices that fix the ordinary unit circle (a Hermitean
form with (1, 1) signature, i.e., one positive and one negative
element on the diagonal). These are extremely important for further
formalization, since they will represent disc automorphisims and
isometries of the Poincar\'e disc. The development of this theory
follows the development of the theory of generalized unitary matrices.
›

text ‹Unitary11 matrices›
definition unitary11 where
  "unitary11 M  congruence M (1, 0, 0, -1) = (1, 0, 0, -1)"

text ‹Generalized unitary11 matrices›
definition unitary11_gen where
  "unitary11_gen M  ( k. k  0  congruence M (1, 0, 0, -1) = k *sm (1, 0, 0, -1))"

text ‹Scalar can always be a non-zero real number›
lemma unitary11_gen_real:
  shows "unitary11_gen M  ( k. k  0  congruence M (1, 0, 0, -1) = cor k *sm (1, 0, 0, -1))"
  unfolding unitary11_gen_def
proof (auto simp del: congruence_def)
  fix k
  assume "k  0" "congruence M (1, 0, 0, -1) = (k, 0, 0, - k)"
  hence "mat_det (congruence M (1, 0, 0, -1)) = -k*k"
    by simp
  moreover
  have "is_real (mat_det (congruence M (1, 0, 0, -1)))" "Re (mat_det (congruence M (1, 0, 0, -1)))  0"
    by (auto simp add: mat_det_adj)
  ultimately
  have "is_real (k*k)" "Re (-k*k)  0"
    by auto
  hence "is_real (k*k)  Re (k * k) > 0"
    using k  0
    by (smt complex_eq_if_Re_eq mult_eq_0_iff mult_minus_left uminus_complex.simps(1) zero_complex.simps(1) zero_complex.simps(2))
  hence "is_real k"
    by auto
  thus "ka. ka  0  k = cor ka"
    using k  0
    by (rule_tac x="Re k" in exI) (cases k, auto simp add: Complex_eq)
qed

text ‹Unitary11 matrices are special cases of generalized unitary 11 matrices›
lemma unitary11_unitary11_gen [simp]:
  assumes "unitary11 M"
  shows "unitary11_gen M"
  using assms
  unfolding unitary11_gen_def unitary11_def
  by (rule_tac x="1" in exI, auto)

text ‹All generalized unitary11 matrices are regular›
lemma unitary11_gen_regular:
  assumes "unitary11_gen M"
  shows "mat_det M  0"
proof-
  from assms obtain k where
    "k  0" "mat_adj M *mm (1, 0, 0, -1) *mm M = cor k *sm (1, 0, 0, -1)"
    unfolding unitary11_gen_real
    by auto
  hence "mat_det (mat_adj M *mm (1, 0, 0, -1) *mm M)  0"
    by simp
  thus ?thesis
    by (simp add: mat_det_adj)
qed

lemmas unitary11_regular = unitary11_gen_regular[OF unitary11_unitary11_gen]

(* ----------------------------------------------------------------- *)
subsubsection ‹The characterization in terms of matrix elements›
(* ----------------------------------------------------------------- *)

text ‹Special matrices are those having the determinant equal to 1. We first give their characterization.›
lemma unitary11_special:
  assumes "unitary11 M" and "mat_det M = 1"
  shows " a b. M = (a, b, cnj b, cnj a)"
proof-
  have "mat_adj M *mm (1, 0, 0, -1) = (1, 0, 0, -1) *mm mat_inv M"
    using assms mult_mm_inv_r
    by (simp add: unitary11_def)
  thus ?thesis
    using assms(2)
    by (cases M) (simp add: mat_adj_def mat_cnj_def)
qed

lemma unitary11_gen_special:
  assumes "unitary11_gen M" and "mat_det M = 1"
  shows " a b. M = (a, b, cnj b, cnj a)  M = (a, b, -cnj b, -cnj a)"
proof-
  from assms
  obtain k where *: "k  0" "mat_adj M *mm (1, 0, 0, -1) *mm M = cor k *sm (1, 0, 0, -1)"
    unfolding unitary11_gen_real
    by auto
  hence "mat_det (mat_adj M *mm (1, 0, 0, -1) *mm M) = -  cor k* cor k"
    by simp
  hence "mat_det (mat_adj M *mm M) = cor k* cor k"
    by simp
  hence "cor k* cor k = 1"
    using assms(2)
    by (simp add: mat_det_adj)
  hence "cor k = 1  cor k = -1"
    using square_eq_1_iff[of "cor k"]
    by simp
  moreover
  have "mat_adj M *mm (1, 0, 0, -1) = (cor k *sm (1, 0, 0, -1)) *mm mat_inv M "
    using *
    using assms mult_mm_inv_r mat_eye_r mat_eye_l
    by auto
  moreover
  obtain a b c d where "M = (a, b, c, d)"
    by (cases M) auto
  ultimately
  have "M = (a, b, cnj b, cnj a)  M = (a, b, -cnj b, -cnj a)"
    using assms(2)
    by (auto simp add: mat_adj_def mat_cnj_def)
  thus ?thesis
    by auto
qed

text ‹A characterization of all generalized unitary11 matrices›
lemma unitary11_gen_iff':
  shows "unitary11_gen M 
         ( a b k. k  0  mat_det (a, b, cnj b, cnj a)  0 
                           (M = k *sm (a, b, cnj b, cnj a)  
                            M = k *sm (-1, 0, 0, 1) *mm (a, b, cnj b, cnj a)))" (is "?lhs = ?rhs")
proof
  assume ?lhs
  obtain d where *: "d*d = mat_det M"
    using ex_complex_sqrt
    by auto
  hence "d  0"
    using unitary11_gen_regular[OF ‹unitary11_gen M]
    by auto
  from ‹unitary11_gen M
  obtain k where "k  0" "mat_adj M *mm (1, 0, 0, -1) *mm M = cor k *sm (1, 0, 0, -1)"
    unfolding unitary11_gen_real
    by auto
  hence "mat_adj ((1/d)*smM)*mm (1, 0, 0, -1) *mm ((1/d)*smM) = (cor k / (d*cnj d)) *sm (1, 0, 0, -1)"
    by simp
  moreover
  have "is_real (cor k / (d * cnj d))"
    by (metis complex_In_mult_cnj_zero div_reals Im_complex_of_real)
  hence "cor (Re (cor k / (d * cnj d))) = cor k / (d * cnj d)"
    by simp
  ultimately
  have "unitary11_gen ((1/d)*smM)"
    unfolding unitary11_gen_real
    using d  0 k  0
    using ‹cor (Re (cor k / (d * cnj d))) = cor k / (d * cnj d)
    by (rule_tac x="Re (cor k / (d * cnj d))" in exI, auto, simp add: *)
  moreover
  have "mat_det ((1 / d) *sm M) = 1"
    using * unitary11_gen_regular[of M] ‹unitary11_gen M
    by auto
  ultimately
  obtain a b where "(a, b, cnj b, cnj a) = (1 / d) *sm M  (a, b, -cnj b, -cnj a) = (1 / d) *sm M"
    using unitary11_gen_special[of "(1 / d) *sm M"]
    by force
  thus ?rhs
  proof
    assume "(a, b, cnj b, cnj a) = (1 / d) *sm M"
    moreover
    hence "mat_det (a, b, cnj b, cnj a)  0"
      using unitary11_gen_regular[OF ‹unitary11_gen M] d  0
      by auto
    ultimately
    show ?rhs
      using d  0
      by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="d" in exI, simp)
  next
    assume *: "(a, b, -cnj b, -cnj a) = (1 / d) *sm M"
    hence " (1 / d) *sm M = (a, b, -cnj b, -cnj a)"
      by simp
    hence "M = (a * d, b * d, - (d * cnj b), - (d * cnj a))"
      using d  0
      using mult_sm_inv_l[of "1/d" M "(a, b, -cnj b, -cnj a)", symmetric]
      by (simp add: field_simps)
    moreover
    have "mat_det (a, b, -cnj b, -cnj a)  0"
      using * unitary11_gen_regular[OF ‹unitary11_gen M] d  0
      by auto
    ultimately
    show ?thesis
      using d  0
      by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="-d" in exI) (simp add: field_simps)
  qed
next
  assume ?rhs
  then obtain a b k where "k  0" "mat_det (a, b, cnj b, cnj a)  0"
    "M = k *sm (a, b, cnj b, cnj a)  M = k *sm (-1, 0, 0, 1) *mm (a, b, cnj b, cnj a)"
    by auto
  moreover
  let ?x = "cnj k * cnj a * (k * a) + - (cnj k * b * (k * cnj b))"
  have "?x = (k*cnj k)*(a*cnj a - b*cnj b)"
    by (auto simp add: field_simps)
  hence "is_real ?x"
    by simp
  hence "cor (Re ?x) = ?x"
    by (rule complex_of_real_Re)
  moreover
  have "?x  0"
    using mult_eq_0_iff[of "cnj k * k" "(cnj a * a + - cnj b * b)"]
    using ‹mat_det (a, b, cnj b, cnj a)  0 k  0
    by (auto simp add: field_simps)
  hence "Re ?x  0"
    using ‹is_real ?x
    by (metis calculation(4) of_real_0)
  ultimately
  show ?lhs
    unfolding unitary11_gen_real
    by (rule_tac x="Re ?x" in exI) (auto simp add: mat_adj_def mat_cnj_def)
qed

text ‹Another characterization of all generalized unitary11 matrices. They are products of 
rotation and Blaschke factor matrices.›
lemma unitary11_gen_cis_blaschke:
  assumes "k  0" and "M = k *sm (a, b, cnj b, cnj a)" and 
          "a  0" and "mat_det (a, b, cnj b, cnj a)  0"
  shows " k' φ a'. k'  0  a' * cnj a'  1  
                                 M = k' *sm (cis φ, 0, 0, 1) *mm (1, -a', -cnj a', 1)"
proof-
  have "a = cnj a * cis (2 * arg a)"
    using rcis_cmod_arg[of a] rcis_cnj[of a]
    using cis_rcis_eq rcis_mult
    by simp
  thus ?thesis
    using assms
    by (rule_tac x="k*cnj a" in exI, rule_tac x="2*arg a" in exI, rule_tac x="- b / a" in exI) (auto simp add: field_simps)
qed

lemma unitary11_gen_cis_blaschke':
  assumes "k  0" and "M = k *sm (-1, 0, 0, 1) *mm (a, b, cnj b, cnj a)" and
          "a  0" and "mat_det (a, b, cnj b, cnj a)  0"
  shows " k' φ a'. k'  0  a' * cnj a'  1 
                                 M = k' *sm (cis φ, 0, 0, 1) *mm (1, -a', -cnj a', 1)"
proof-
  obtain k' φ a' where *: "k'  0" "k *sm (a, b, cnj b, cnj a) = k' *sm (cis φ, 0, 0, 1) *mm (1, -a', -cnj a', 1)" "a' * cnj a'  1"
    using unitary11_gen_cis_blaschke[OF k  0 _ a  0] ‹mat_det (a, b, cnj b, cnj a)  0
    by blast
  have "(cis φ, 0, 0, 1) *mm (-1, 0, 0, 1) = (cis (φ + pi), 0, 0, 1)"
   by (simp add: cis_def complex.corec Complex_eq)
  thus ?thesis
    using * M = k *sm (-1, 0, 0, 1) *mm (a, b, cnj b, cnj a)
    by (rule_tac x="k'" in exI, rule_tac x="φ + pi" in exI, rule_tac x="a'" in exI, simp)
qed

lemma unitary11_gen_cis_blaschke_rev:
  assumes "k'  0" and "M = k' *sm (cis φ, 0, 0, 1) *mm (1, -a', -cnj a', 1)" and
          "a' * cnj a'  1"
  shows " k a b. k  0  mat_det (a, b, cnj b, cnj a)  0  
                          M = k *sm (a, b, cnj b, cnj a)"
  using assms
  apply (rule_tac x="k'*cis(φ/2)" in exI, rule_tac x="cis(φ/2)" in exI, rule_tac x="-a'*cis(φ/2)" in exI)
  apply (simp add: cis_mult mult.commute mult.left_commute)
  done

lemma unitary11_gen_cis_inversion:
  assumes "k  0" and "M = k *sm (0, b, cnj b, 0)" and "b  0"
  shows " k' φ. k'  0 
                              M = k' *sm (cis φ, 0, 0, 1) *mm (0, 1, 1, 0)"
using assms
using rcis_cmod_arg[of b, symmetric] rcis_cnj[of b] cis_rcis_eq
by simp (rule_tac x="2*arg b" in exI, simp add: rcis_mult)

lemma unitary11_gen_cis_inversion':
  assumes "k  0" and "M = k *sm (-1, 0, 0, 1) *mm (0, b, cnj b, 0)" and "b  0"
  shows " k' φ. k'  0 
                   M = k' *sm (cis φ, 0, 0, 1) *mm (0, 1, 1, 0)"
proof-
  obtain k' φ where *: "k'  0" "k *sm (0, b, cnj b, 0) = k' *sm (cis φ, 0, 0, 1) *mm (0, 1, 1, 0)"
    using unitary11_gen_cis_inversion[OF k  0 _ b  0]
    by metis
  have "(cis φ, 0, 0, 1) *mm (-1, 0, 0, 1) = (cis (φ + pi), 0, 0, 1)"
    by (simp add: cis_def complex.corec Complex_eq)
  thus ?thesis
    using * M = k *sm (-1, 0, 0, 1) *mm (0, b, cnj b, 0)
    by (rule_tac x="k'" in exI, rule_tac x="φ + pi" in exI, simp)
qed

lemma unitary11_gen_cis_inversion_rev:
  assumes "k'  0" and "M = k' *sm (cis φ, 0, 0, 1) *mm (0, 1, 1, 0)"
  shows " k a b. k  0  mat_det (a, b, cnj b, cnj a)  0 
                          M = k *sm (a, b, cnj b, cnj a)"
  using assms
  by (rule_tac x="k'*cis(φ/2)" in exI, rule_tac x=0 in exI, rule_tac x="cis(φ/2)" in exI) (simp add: cis_mult)

text ‹Another characterization of generalized unitary11 matrices›
lemma unitary11_gen_iff:
  shows "unitary11_gen M  
         ( k a b. k  0  mat_det (a, b, cnj b, cnj a)  0 
                           M = k *sm (a, b, cnj b, cnj a))" (is "?lhs = ?rhs")
proof
  assume ?lhs
  then obtain a b k where *: "k  0" "mat_det (a, b, cnj b, cnj a)  0" "M = k *sm (a, b, cnj b, cnj a)  M = k *sm (-1, 0, 0, 1) *mm (a, b, cnj b, cnj a)"
    using unitary11_gen_iff'
    by auto
  show ?rhs
  proof (cases "M = k *sm (a, b, cnj b, cnj a)")
    case True
    thus ?thesis
      using *
      by auto
  next
    case False
    hence **: "M = k *sm (-1, 0, 0, 1) *mm (a, b, cnj b, cnj a)"
      using *
      by simp
    show ?thesis
    proof (cases "a = 0")
      case True
      hence "b  0"
        using *
        by auto
      show ?thesis
        using unitary11_gen_cis_inversion_rev[of _ M]
        using ** a = 0
        using unitary11_gen_cis_inversion'[OF k  0 _ b  0, of M]
        by auto
    next
      case False
      show ?thesis
        using unitary11_gen_cis_blaschke_rev[of _ M]
        using **
        using unitary11_gen_cis_blaschke'[OF k  0 _ a  0, of M b] ‹mat_det (a, b, cnj b, cnj a)  0
        by blast
    qed
  qed
next
  assume ?rhs
  thus ?lhs
    using unitary11_gen_iff'
    by auto
qed

lemma unitary11_iff:
  shows "unitary11 M 
         ( a b k. (cmod a)2 > (cmod b)2 
                           (cmod k)2 = 1 / ((cmod a)2 - (cmod b)2) 
                           M = k *sm (a, b, cnj b, cnj a))" (is "?lhs = ?rhs")
proof
  assume ?lhs
  obtain k a b where *:
    "M = k *sm (a, b, cnj b, cnj a)""mat_det (a, b, cnj b, cnj a)  0" "k  0"
    using unitary11_gen_iff unitary11_unitary11_gen[OF ‹unitary11 M]
    by auto

  have md: "mat_det (a, b, cnj b, cnj a) = cor ((cmod a)2 - (cmod b)2)"
    by (auto simp add: complex_mult_cnj_cmod)
  hence **: "(cmod a)2  (cmod b)2"
    using ‹mat_det (a, b, cnj b, cnj a)  0
    by auto

  have "k * cnj k * mat_det (a, b, cnj b, cnj a) = 1"
    using M = k *sm (a, b, cnj b, cnj a)
    using ‹unitary11 M
    unfolding unitary11_def
    by (auto simp add: mat_adj_def mat_cnj_def) (simp add: field_simps)
  hence ***: "(cmod k)2 * ((cmod a)2 - (cmod b)2) = 1"
    by (metis complex_mult_cnj_cmod md of_real_1 of_real_eq_iff of_real_mult)
  hence "((cmod a)2 - (cmod b)2) = 1 / (cmod k)2"
    by (cases "k=0") (auto simp add: field_simps)
  hence "cmod a ^ 2 = cmod b ^ 2 + 1 / cmod k ^ 2"
    by simp
  thus ?rhs
    using M = k *sm (a, b, cnj b, cnj a) ** mat_eye_l
    by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="k" in exI)
       (auto simp add: complex_mult_cnj_cmod intro!: )
next
  assume ?rhs
  then obtain a b k where "(cmod b)2 < (cmod a)2  (cmod k)2 = 1 / ((cmod a)2 - (cmod b)2)  M = k *sm (a, b, cnj b, cnj a)"
    by auto
  moreover
  have "cnj k * cnj a * (k * a) + - (cnj k * b * (k * cnj b)) = (cor ((cmod k)2 * ((cmod a)2 - (cmod b)2)))"
  proof-
    have "cnj k * cnj a * (k * a) = cor ((cmod k)2 * (cmod a)2)"
      using complex_mult_cnj_cmod[of a] complex_mult_cnj_cmod[of k]
      by (auto simp add: field_simps)
    moreover
    have "cnj k * b * (k * cnj b) = cor ((cmod k)2 * (cmod b)2)"
      using complex_mult_cnj_cmod[of b, symmetric] complex_mult_cnj_cmod[of k]
      by (auto simp add: field_simps)
    ultimately
    show ?thesis
      by (auto simp add: field_simps)
  qed
  ultimately
  show ?lhs
    unfolding unitary11_def
    by (auto simp add: mat_adj_def mat_cnj_def field_simps)
qed

(* ----------------------------------------------------------------- *)
subsubsection ‹Group properties›
(* ----------------------------------------------------------------- *)

text ‹Generalized unitary11 matrices form a group under
multiplication (it is sometimes denoted by $GU_{1, 1}(2,
\mathbb{C})$). The group is also closed under non-zero complex scalar
multiplication. Since these matrices are always regular, they form a
subgroup of general linear group (usually denoted by $GL(2,
\mathbb{C})$) of all regular matrices.›

lemma unitary11_gen_mult_sm:
  assumes "k  0" and "unitary11_gen M"
  shows "unitary11_gen (k *sm M)"
proof-
  have "k * cnj k = cor (Re (k * cnj k))"
    by (subst complex_of_real_Re) auto
  thus ?thesis
    using assms
    unfolding unitary11_gen_real
    by auto (rule_tac x="Re (k*cnj k) * ka" in exI, auto)
qed

lemma unitary11_gen_div_sm:
  assumes "k  0" and "unitary11_gen (k *sm M)"
  shows "unitary11_gen M"
  using assms unitary11_gen_mult_sm[of "1/k" "k *sm M"]
  by simp


lemma unitary11_inv:
  assumes "k  0" and "M = k *sm (a, b, cnj b, cnj a)" and "mat_det (a, b, cnj b, cnj a)  0"
  shows " k' a' b'. k'  0  mat_inv M = k' *sm (a', b', cnj b', cnj a')  mat_det (a', b', cnj b', cnj a')  0"
  using assms
  by (subst assms, subst mat_inv_mult_sm[OF assms(1)])
     (rule_tac x="1/(k * mat_det (a, b, cnj b, cnj a))" in exI, rule_tac x="cnj a" in exI, rule_tac x="-b" in exI, simp add: field_simps)

lemma unitary11_comp:
  assumes "k1  0" and "M1 = k1 *sm (a1, b1, cnj b1, cnj a1)" and "mat_det (a1, b1, cnj b1, cnj a1)  0"
          "k2  0" "M2 = k2 *sm (a2, b2, cnj b2, cnj a2)" "mat_det (a2, b2, cnj b2, cnj a2)  0"
  shows " k a b. k  0  M1 *mm M2 = k *sm (a, b, cnj b, cnj a)  mat_det (a, b, cnj b, cnj a)  0"
  using assms
  apply (rule_tac x="k1*k2" in exI)
  apply (rule_tac x="a1*a2 + b1*cnj b2" in exI)
  apply (rule_tac x="a1*b2 + b1*cnj a2" in exI)
proof (auto simp add: algebra_simps)
  assume *: "a1 * (a2 * (cnj a1 * cnj a2)) + b1 * (b2 * (cnj b1 * cnj b2)) =
            a1 * (b2 * (cnj a1 * cnj b2)) + a2 * (b1 * (cnj a2 * cnj b1))" and
         **: "a1*cnj a1  b1 * cnj b1" "a2*cnj a2  b2*cnj b2"
  hence "(a1*cnj a1)*(a2*cnj a2 - b2*cnj b2) = (b1*cnj b1)*(a2*cnj a2 - b2*cnj b2)"
    by (simp add: field_simps)
  hence "a1*cnj a1 = b1*cnj b1"
    using **(2)
    by simp
  thus False
    using **(1)
    by simp
qed

lemma unitary11_gen_mat_inv:
  assumes "unitary11_gen M" and "mat_det M  0"
  shows "unitary11_gen (mat_inv M)"
proof-
  obtain k a b where "k  0  mat_det (a, b, cnj b, cnj a)  0  M = k *sm (a, b, cnj b, cnj a)"
    using assms unitary11_gen_iff[of M]
    by auto
  then obtain k' a' b' where "k'  0  mat_inv M = k' *sm (a', b', cnj b', cnj a')  mat_det (a', b', cnj b', cnj a')  0"
    using unitary11_inv [of k M a b]
    by auto
  thus ?thesis
    using unitary11_gen_iff[of "mat_inv M"]
    by auto
qed

lemma unitary11_gen_comp:
  assumes "unitary11_gen M1" and "mat_det M1  0" and "unitary11_gen M2"  and "mat_det M2  0"
  shows "unitary11_gen (M1 *mm M2)"
proof-
  from assms obtain k1 k2 a1 a2 b1 b2 where
    "k1  0  mat_det (a1, b1, cnj b1, cnj a1)  0  M1 = k1 *sm (a1, b1, cnj b1, cnj a1)"
    "k2  0  mat_det (a2, b2, cnj b2, cnj a2)  0  M2 = k2 *sm (a2, b2, cnj b2, cnj a2)"
    using unitary11_gen_iff[of M1]  unitary11_gen_iff[of M2]
    by blast
  then obtain k a b where "k  0  M1 *mm M2 = k *sm (a, b, cnj b, cnj a)  mat_det (a, b, cnj b, cnj a)  0"
    using unitary11_comp[of k1 M1 a1 b1 k2 M2 a2 b2]
    by blast
  thus ?thesis
    using unitary11_gen_iff[of "M1 *mm M2"]
    by blast
qed

text ‹Classification into orientation-preserving and orientation-reversing matrices›
lemma unitary11_sgn_det_orientation:
  assumes "k  0" and "mat_det (a, b, cnj b, cnj a)  0" and "M = k *sm (a, b, cnj b, cnj a)"
  shows " k'. sgn k' = sgn (Re (mat_det (a, b, cnj b, cnj a)))  congruence M (1, 0, 0, -1) = cor k' *sm (1, 0, 0, -1)"
proof-
  let ?x = "cnj k * cnj a * (k * a) - (cnj k * b * (k * cnj b))"
  have *: "?x = k * cnj k * (a * cnj a - b * cnj b)"
    by (auto simp add: field_simps)
  hence "is_real ?x"
    by auto
  hence "cor (Re ?x) = ?x"
    by (rule complex_of_real_Re)
  moreover
  have "sgn (Re ?x) = sgn (Re (a * cnj a - b * cnj b))"
  proof-
    have *: "Re ?x = (cmod k)2 * Re (a * cnj a - b * cnj b)"
      by (subst *, subst complex_mult_cnj_cmod, subst Re_mult_real) (metis Im_complex_of_real, metis Re_complex_of_real)
    show ?thesis
      using k  0
      by (subst *) (simp add: sgn_mult)
  qed
  ultimately
  show ?thesis
    using assms(3)
    by (rule_tac x="Re ?x" in exI) (auto simp add: mat_adj_def mat_cnj_def)
qed

lemma unitary11_sgn_det:
  assumes "k  0" and "mat_det (a, b, cnj b, cnj a)  0" and "M = k *sm (a, b, cnj b, cnj a)" and "M = (A, B, C, D)"
  shows "sgn (Re (mat_det (a, b, cnj b, cnj a))) = (if b = 0 then 1 else sgn (Re ((A*D)/(B*C)) - 1))"
proof (cases "b = 0")
  case True
  thus ?thesis
    using assms
    by (simp only: mat_det.simps, subst complex_mult_cnj_cmod, subst minus_complex.sel, subst Re_complex_of_real, simp)
next
  case False
  from assms have *: "A =  k * a" "B =  k * b" "C =  k * cnj b" "D =  k * cnj a"
    by auto
  hence *: "(A*D)/(B*C) = (a*cnj a)/(b*cnj b)"
    using k  0
    by simp
  show ?thesis
    using b  0
    apply (subst *, subst Re_divide_real, simp, simp)
    apply (simp only: mat_det.simps)
    apply (subst complex_mult_cnj_cmod)+
    apply ((subst Re_complex_of_real)+, subst minus_complex.sel, (subst Re_complex_of_real)+, simp add: field_simps sgn_if)
    done
qed

lemma unitary11_orientation:
  assumes "unitary11_gen M" and "M = (A, B, C, D)"
  shows " k'. sgn k' = sgn (if B = 0 then 1 else sgn (Re ((A*D)/(B*C)) - 1))  congruence M (1, 0, 0, -1) = cor k' *sm (1, 0, 0, -1)"
proof-
  from ‹unitary11_gen M
  obtain k a b where *: "k  0" "mat_det (a, b, cnj b, cnj a)  0" "M = k*sm (a, b, cnj b, cnj a)"
    using unitary11_gen_iff[of M]
    by auto
  moreover
  have "b = 0  B = 0"
    using M = (A, B, C, D) *
    by auto
  ultimately
  show ?thesis
    using unitary11_sgn_det_orientation[OF *] unitary11_sgn_det[OF * M = (A, B, C, D)]
    by auto
qed

lemma unitary11_sgn_det_orientation':
  assumes "congruence M (1, 0, 0, -1) = cor k' *sm (1, 0, 0, -1)" and "k'  0"
  shows " a b k. k  0  M = k *sm (a, b, cnj b, cnj a)  sgn k' = sgn (Re (mat_det (a, b, cnj b, cnj a)))"
proof-
  obtain a b k where
    "k  0" "mat_det (a, b, cnj b, cnj a)  0" "M = k *sm (a, b, cnj b, cnj a)"
    using assms
    using unitary11_gen_iff[of M]
    unfolding unitary11_gen_def
    by auto
  moreover
  have "sgn k' = sgn (Re (mat_det (a, b, cnj b, cnj a)))"
  proof-
    let ?x = "cnj k * cnj a * (k * a) - (cnj k * b * (k * cnj b))"
    have *: "?x = k * cnj k * (a * cnj a - b * cnj b)"
      by (auto simp add: field_simps)
    hence "is_real ?x"
      by auto
    hence "cor (Re ?x) = ?x"
      by (rule complex_of_real_Re)

    have **: "sgn (Re ?x) = sgn (Re (a * cnj a - b * cnj b))"
    proof-
      have *: "Re ?x = (cmod k)2 * Re (a * cnj a - b * cnj b)"
        by (subst *, subst complex_mult_cnj_cmod, subst Re_mult_real) (metis Im_complex_of_real, metis Re_complex_of_real)
      show ?thesis
        using k  0
        by (subst *) (simp add: sgn_mult)
    qed
    moreover
    have "?x = cor k'"
      using M = k *sm (a, b, cnj b, cnj a) assms
      by (simp add: mat_adj_def mat_cnj_def)
    hence "sgn (Re ?x) = sgn k'"
      using ‹cor (Re ?x) = ?x
      unfolding complex_of_real_def
      by simp
    ultimately
    show ?thesis
      by simp
  qed
  ultimately
  show ?thesis
    by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="k" in exI)  simp
qed

end

Theory Hermitean_Matrices

(* -------------------------------------------------------------------------- *)
subsection ‹Hermitean matrices›
(* -------------------------------------------------------------------------- *)

text ‹Hermitean matrices over $\mathbb{C}$ generalize symmetric matrices over $\mathbb{R}$. Quadratic
forms with Hermitean matrices represent circles and lines in the extended complex plane (when
applied to homogenous coordinates).›

theory Hermitean_Matrices
imports Unitary_Matrices
begin

definition hermitean :: "complex_mat  bool" where
 "hermitean A  mat_adj A = A"

lemma hermitean_transpose:
  shows "hermitean A  mat_transpose A = mat_cnj A"
  unfolding hermitean_def
  by (cases A) (auto simp add: mat_adj_def mat_cnj_def)

text ‹Characterization of 2x2 Hermitean matrices elements. 
All 2x2 Hermitean matrices are of the form 
$$
\left(
\begin{array}{cc}
A & B\\
\overline{B} & D
\end{array}
\right),
$$
for real $A$ and $D$ and complex $B$.
›

lemma hermitean_mk_circline [simp]: 
  shows "hermitean (cor A, B, cnj B, cor D)"
  unfolding hermitean_def mat_adj_def mat_cnj_def
  by simp

lemma hermitean_mk_circline' [simp]:
  assumes "is_real A" and "is_real D"
  shows "hermitean (A, B, cnj B, D)"
  using assms eq_cnj_iff_real
  unfolding hermitean_def mat_adj_def mat_cnj_def
  by force

lemma hermitean_elems:
  assumes "hermitean (A, B, C, D)"
  shows "is_real A" and "is_real D" and "B = cnj C" and "cnj B = C"
  using assms eq_cnj_iff_real[of A] eq_cnj_iff_real[of D]
  by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)

text ‹Operations that preserve the Hermitean property›

lemma hermitean_mat_cnj: 
  shows "hermitean H  hermitean (mat_cnj H)"
  by (cases H) (auto simp add:  hermitean_def mat_adj_def mat_cnj_def)

lemma hermitean_mult_real:
  assumes "hermitean H"
  shows "hermitean ((cor k) *sm H)"
  using assms
  unfolding hermitean_def
  by simp

lemma hermitean_congruence:
  assumes "hermitean H"
  shows "hermitean (congruence M H)"
  using assms
  unfolding hermitean_def
  by (auto simp add: mult_mm_assoc)

text ‹Identity matrix is Hermitean›

lemma hermitean_eye [simp]:
  shows "hermitean eye"
  by (auto simp add:  hermitean_def mat_adj_def mat_cnj_def)

lemma hermitean_eye' [simp]: 
  shows "hermitean (1, 0, 0, 1)"
  by (auto simp add:  hermitean_def mat_adj_def mat_cnj_def)

text ‹Unit circle matrix is Hermitean›

lemma hermitean_unit_circle [simp]:
  shows "hermitean (1, 0, 0, -1)"
  by (auto simp add:  hermitean_def mat_adj_def mat_cnj_def)

text ‹Hermitean matrices have real determinant›
lemma mat_det_hermitean_real:
  assumes "hermitean A"
  shows "is_real (mat_det A)"
  using assms
  unfolding hermitean_def
  by (metis eq_cnj_iff_real mat_det_adj)

text ‹Zero matrix is the only Hermitean matrix with both determinant and trace equal
to zero›
lemma hermitean_det_zero_trace_zero:
  assumes "mat_det A = 0" and "mat_trace A = (0::complex)" and "hermitean A"
  shows "A = mat_zero"
using assms
proof-
  {
    fix a d c
    assume "a * d = cnj c * c" "a + d = 0" "cnj a = a"
    from a + d = 0 have "d = -a"
      by (metis add_eq_0_iff)
    hence "- (cor (Re a))2  = (cor (cmod c))2"
      using ‹cnj a = a eq_cnj_iff_real[of a]
      using a*d = cnj c * c
      using complex_mult_cnj_cmod[of "cnj c"]
      by (simp add: power2_eq_square)
    hence "- (Re a)2  0"
      using zero_le_power2[of "cmod c"]
      by (metis Re_complex_of_real of_real_minus of_real_power)
    hence "a = 0"
      using zero_le_power2[of "Re a"]
      using ‹cnj a = a  eq_cnj_iff_real[of a]
      by (simp add: complex_eq_if_Re_eq)
  } note * = this
  obtain a b c d where "A = (a, b, c, d)"
    by (cases A) auto
  thus ?thesis
    using *[of a d c]  *[of d a c]
    using assms A = (a, b, c, d)
    by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
qed

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Bilinear and quadratic forms with Hermitean matrices›
(* ---------------------------------------------------------------------------- *)

text ‹A Hermitean matrix $(A, B, \overline{B}, D)$, for real $A$ and $D$, gives rise to bilinear form
$A\cdot \overline{v_{11}} \cdot v_{21}+\overline{B} \cdot \overline{v_{12}} \cdot v_{21} +
B \cdot \overline{v_{11}} \cdot v_{22}+D\cdot \overline{v_{12}}\cdot v_{22}$ (acting on vectors $(v_{11}, v_{12})$ and
$(v_{21}, v_{22})$) and to the quadratic form $A \cdot \overline{v_1} \cdot v_1+\overline{B}\cdot \overline{v_2}\cdot v_1 +
B\cdot \overline{v_1}\cdot v_2 + D\cdot \overline{v_2} \cdot v_2$ (acting on the vector $(v_1, v_2)$).›

lemma bilinear_form_hermitean_commute:
  assumes "hermitean H"
  shows "bilinear_form v1 v2 H = cnj (bilinear_form v2 v1 H)"
proof-
  have "v2 *vm mat_cnj H *vv vec_cnj v1 = vec_cnj v1 *vv (mat_adj H *mv v2)"
    by (subst mult_vv_commute, subst mult_mv_mult_vm, simp add: mat_adj_def mat_transpose_mat_cnj)
  also
  have " = bilinear_form v1 v2 H"
    using assms
    by (simp add: mult_vv_mv hermitean_def)
  finally
  show ?thesis
    by (simp add: cnj_mult_vv vec_cnj_mult_vm)
qed

lemma quad_form_hermitean_real:
  assumes "hermitean H"
  shows "is_real (quad_form z H)"
  using assms
  by (subst eq_cnj_iff_real[symmetric])  (simp del: quad_form_def add: hermitean_def)

lemma quad_form_vec_cnj_mat_cnj:
  assumes "hermitean H"
  shows "quad_form (vec_cnj z) (mat_cnj H) = quad_form z H"
  using assms
  using cnj_mult_vv cnj_quad_form hermitean_def vec_cnj_mult_vm by auto

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Eigenvalues, eigenvectors and diagonalization of Hermitean matrices›
(* ---------------------------------------------------------------------------- *)

text ‹Hermitean matrices have real eigenvalues›
lemma hermitean_eigenval_real:
  assumes "hermitean H" and "eigenval k H"
  shows "is_real k"
proof-
  from assms obtain v where "v  vec_zero" "H *mv v = k *sv v"
    unfolding eigenval_def
    by blast
  have "k * (v *vv vec_cnj v) = (k *sv v) *vv (vec_cnj v)"
    by (simp add: mult_vv_scale_sv1)
  also have "... = (H *mv v) *vv (vec_cnj v)"
    using H *mv v = k *sv v
    by simp
  also have "... =  v *vv (mat_transpose H *mv (vec_cnj v))"
    by (simp add: mult_mv_vv)
  also have "... = v *vv (vec_cnj (mat_cnj (mat_transpose H) *mv v))"
    by (simp add: vec_cnj_mult_mv)
  also have "... = v *vv (vec_cnj (H *mv v))"
    using ‹hermitean H
    by (simp add: hermitean_def mat_adj_def)
  also have "... = v *vv (vec_cnj (k *sv v))"
    using H *mv v = k *sv v
    by simp
  finally have "k * (v *vv vec_cnj v) = cnj k * (v *vv vec_cnj v)"
    by (simp add: mult_vv_scale_sv2)
  hence "k = cnj k"
    using v  vec_zero›
    using scalsquare_vv_zero[of v]
    by (simp add: mult_vv_commute)
  thus ?thesis
    by (metis eq_cnj_iff_real)
qed

text ‹Non-diagonal Hermitean matrices have distinct eigenvalues›
lemma hermitean_distinct_eigenvals:
  assumes "hermitean H"
  shows "( k1 k2. k1  k2  eigenval k1 H  eigenval k2 H)  mat_diagonal H"
proof-
  obtain A B C D where HH: "H = (A, B, C, D)"
    by (cases H) auto
  show ?thesis
  proof (cases "B = 0")
    case True
    thus ?thesis
      using ‹hermitean H hermitean_elems[of A B C D] HH
      by auto
  next
    case False
    have "(mat_trace H)2  4 * mat_det H"
    proof (rule ccontr)
      have "C = cnj B" "is_real A" "is_real D"
        using hermitean_elems HH ‹hermitean H
        by auto
      assume "¬ ?thesis"
      hence "(A + D)2 = 4*(A*D - B*C)"
        using HH
        by auto
      hence "(A - D)2 = - 4*B*cnj B"
        using C = cnj B
        by (auto simp add: power2_eq_square field_simps)
      hence "(A - D)2 / cor ((cmod B)2) = -4"
        using B  0 complex_mult_cnj_cmod[of B]
        by (auto simp add: field_simps)
      hence "(Re A - Re D)2 / (cmod B)2 = -4"
        using ‹is_real A ‹is_real D B  0
        using Re_divide_real[of "cor ((cmod B)2)" "(A - D)2"]
        by (auto simp add: power2_eq_square)
      thus False
        by (metis abs_neg_numeral abs_power2 neg_numeral_neq_numeral power_divide)
    qed
    show ?thesis
      apply (rule disjI1)
      apply (subst eigen_equation)+
      using complex_quadratic_equation_monic_distinct_roots[of "-mat_trace H" "mat_det H"] (mat_trace H)2  4 * mat_det H
      by auto
  qed
qed

text ‹Eigenvectors corresponding to different eigenvalues of Hermitean matrices are
orthogonal›
lemma hermitean_ortho_eigenvecs:
  assumes "hermitean H"
  assumes "eigenpair k1 v1 H" and "eigenpair k2 v2 H" and "k1  k2"
  shows "vec_cnj v2 *vv v1 = 0" and "vec_cnj v1 *vv v2 = 0"
proof-
  from assms
  have "v1  vec_zero" "H *mv v1 = k1 *sv v1"
       "v2  vec_zero" "H *mv v2 = k2 *sv v2"
    unfolding eigenpair_def
    by auto
  have real_k: "is_real k1" "is_real k2"
    using assms
    using hermitean_eigenval_real[of H k1]
    using hermitean_eigenval_real[of H k2]
    unfolding eigenpair_def eigenval_def
    by blast+

  have "vec_cnj (H *mv v2) = vec_cnj (k2 *sv v2)"
    using H *mv v2 = k2 *sv v2
    by auto
  hence "vec_cnj v2 *vm H  = k2 *sv vec_cnj v2"
    using ‹hermitean H real_k eq_cnj_iff_real[of k1] eq_cnj_iff_real[of k2]
    unfolding hermitean_def
    by (cases H, cases v2) (auto simp add: mat_adj_def mat_cnj_def vec_cnj_def)
  have "k2 * (vec_cnj v2 *vv v1) = k1 * (vec_cnj v2 *vv v1)"
    using H *mv v1 = k1 *sv v1
    using ‹vec_cnj v2 *vm H  = k2 *sv vec_cnj v2
    by (cases v1, cases v2, cases H)
       (metis mult_vv_mv mult_vv_scale_sv1 mult_vv_scale_sv2)
  thus "vec_cnj v2 *vv v1 = 0"
    using k1  k2
    by simp
  hence "cnj (vec_cnj v2 *vv v1) = 0"
    by simp
  thus "vec_cnj v1 *vv v2 = 0"
    by (simp add: cnj_mult_vv mult_vv_commute)
qed

text ‹Hermitean matrices are diagonizable by unitary matrices. Diagonal entries are
real and the sign of the determinant is preserved.›
lemma hermitean_diagonizable:
  assumes "hermitean H"
  shows " k1 k2 M. mat_det M  0  unitary M  congruence M H = (k1, 0, 0, k2) 
                    is_real k1  is_real k2  sgn (Re k1 * Re k2) = sgn (Re (mat_det H))"
proof-
  from assms
  have "(k1 k2. k1  k2  eigenval k1 H  eigenval k2 H)  mat_diagonal H"
    using hermitean_distinct_eigenvals[of H]
    by simp
  thus ?thesis
  proof
    assume "k1 k2. k1  k2  eigenval k1 H  eigenval k2 H"
    then  obtain k1 k2 where  "k1  k2" "eigenval k1 H" "eigenval k2 H"
      using hermitean_distinct_eigenvals
      by blast
    then obtain v1 v2 where "eigenpair k1 v1 H" "eigenpair k2 v2 H"
      "v1  vec_zero" "v2  vec_zero"
      unfolding eigenval_def eigenpair_def
      by blast
    hence *: "vec_cnj v2 *vv v1 = 0" "vec_cnj v1 *vv v2 = 0"
      using k1  k2 hermitean_ortho_eigenvecs ‹hermitean H
      by auto
    obtain v11 v12 v21 v22 where vv: "v1 = (v11, v12)" "v2 = (v21, v22)"
      by  (cases v1, cases v2) auto
    let ?nv1' = "vec_cnj v1 *vv v1" and ?nv2' = "vec_cnj v2 *vv v2"
    let ?nv1 = "cor (sqrt (Re ?nv1'))"
    let ?nv2 = "cor (sqrt (Re ?nv2'))"
    have "?nv1'  0"  "?nv2'  0"
      using v1  vec_zero› v2  vec_zero› vv
      by (simp add: scalsquare_vv_zero)+
    moreover
    have "is_real ?nv1'" "is_real ?nv2'"
      using vv
      by (auto simp add: vec_cnj_def)
    ultimately
    have "?nv1  0"  "?nv2  0"
      using complex_eq_if_Re_eq
      by auto
    have "Re (?nv1')  0"  "Re (?nv2')  0"
      using vv
      by (auto simp add: vec_cnj_def)
    obtain nv1 nv2 where "nv1 = ?nv1" "nv1  0"  "nv2 = ?nv2" "nv2  0"
      using ?nv1  0  ?nv2  0
      by auto
    let ?M = "(1/nv1 * v11, 1/nv2 * v21, 1/nv1 * v12, 1/nv2 * v22)"

    have "is_real k1" "is_real k2"
      using  ‹eigenval k1 H ‹eigenval k2 H ‹hermitean H
      by (auto simp add: hermitean_eigenval_real)
    moreover
    have "mat_det ?M  0"
    proof (rule ccontr)
      assume "¬ ?thesis"
      hence "v11 * v22 = v12 * v21"
        using nv1  0 nv2  0
        by (auto simp add: field_simps)
      hence " k. k  0  v2 = k *sv v1"
        using vv v1  vec_zero› v2  vec_zero›
        apply auto
        apply (rule_tac x="v21/v11" in exI, force simp add: field_simps)
        apply (rule_tac x="v21/v11" in exI, force simp add: field_simps)
        apply (rule_tac x="v22/v12" in exI, force simp add: field_simps)
        apply (rule_tac x="v22/v12" in exI, force simp add: field_simps)
        done
      thus False
        using * ‹vec_cnj v1 *vv v2 = 0 ‹vec_cnj v2 *vv v2  0 vv ?nv1'  0
        by (metis mult_vv_scale_sv2 mult_zero_right)
    qed
    moreover
    have "unitary ?M"
    proof-
      have **: "cnj nv1 * nv1 = ?nv1'"  "cnj nv2 * nv2 = ?nv2'"
        using nv1 = ?nv1 nv1  0  nv2 = ?nv2 nv2  0 ‹is_real ?nv1' ‹is_real ?nv2'
        using ‹Re (?nv1')  0  ‹Re (?nv2')  0
        by auto
      have ***: "cnj nv1 * nv2  0"  "cnj nv2 * nv1  0"
        using vv nv1 = ?nv1 nv1  0  nv2 = ?nv2 nv2  0 ‹is_real ?nv1' ‹is_real ?nv2'
        by auto           

      show ?thesis
        unfolding unitary_def
        using vv ** ?nv1'  0 ?nv2'  0 * ***
        unfolding mat_adj_def mat_cnj_def vec_cnj_def
        by simp (metis (no_types, lifting) add_divide_distrib divide_eq_0_iff divide_eq_1_iff)
    qed
    moreover
    have "congruence ?M H = (k1, 0, 0, k2)"
    proof-
      have "mat_inv ?M *mm H *mm ?M = (k1, 0, 0, k2)"
      proof-
        have *: "H *mm ?M = ?M *mm (k1, 0, 0, k2)"
          using ‹eigenpair k1 v1 H ‹eigenpair k2 v2 H vv ?nv1  0 ?nv2  0
          unfolding eigenpair_def vec_cnj_def
          by (cases H) (smt mult_mm.simps vec_map.simps add.right_neutral add_cancel_left_left distrib_left fst_mult_sv mult.commute mult.left_commute mult_mv.simps mult_zero_right prod.sel(1) prod.sel(2) snd_mult_sv)
        show ?thesis
          using mult_mm_inv_l[of ?M "(k1, 0, 0, k2)" "H *mm ?M", OF ‹mat_det ?M  0 *[symmetric], symmetric]
          by (simp add: mult_mm_assoc)
      qed
      moreover
      have "mat_inv ?M = mat_adj ?M"
        using ‹mat_det ?M  0 ‹unitary ?M mult_mm_inv_r[of ?M "mat_adj ?M" eye]
        by (simp add: unitary_def)
      ultimately
      show ?thesis
        by simp
    qed
    moreover
    have "sgn (Re k1 * Re k2) = sgn (Re (mat_det H))"
      using ‹congruence ?M H = (k1, 0, 0, k2) ‹is_real k1 ‹is_real k2
      using Re_det_sgn_congruence[of ?M H] ‹mat_det ?M  0 ‹hermitean H
      by simp
    ultimately
    show ?thesis
      by (rule_tac x="k1" in exI, rule_tac x="k2" in exI, rule_tac x="?M" in exI) simp
  next
    assume "mat_diagonal H"
    then obtain A D where "H = (A, 0, 0, D)"
      by (cases H) auto
    moreover
    hence "is_real A" "is_real D"
      using ‹hermitean H hermitean_elems[of A 0 0 D]
      by auto
    ultimately
    show ?thesis
      by (rule_tac x="A" in exI, rule_tac x="D" in exI, rule_tac x="eye" in exI) (simp add: unitary_def mat_adj_def mat_cnj_def)
  qed
qed

end

Theory Elementary_Complex_Geometry

(* ----------------------------------------------------------------- *)
section ‹Elementary complex geometry›
(* ----------------------------------------------------------------- *)

text ‹In this section equations and basic properties of the most fundamental objects and relations in
geometry -- collinearity, lines, circles and circlines. These are defined by equations in
$\mathbb{C}$ (not extended by an infinite point). Later these equations will be generalized to
equations in the extended complex plane, over homogenous coordinates.›

theory Elementary_Complex_Geometry
imports More_Complex Linear_Systems Angles
begin

(* ----------------------------------------------------------------- *)
subsection ‹Collinear points›
(* ----------------------------------------------------------------- *)

definition collinear :: "complex  complex  complex  bool" where
  "collinear z1 z2 z3  z1 = z2  Im ((z3 - z1) / (z2 - z1)) = 0"

lemma collinear_ex_real:
  shows "collinear z1 z2 z3 
         ( k::real. z1 = z2  z3 - z1 = complex_of_real k * (z2 - z1))"
  unfolding collinear_def
  by (metis Im_complex_of_real add_diff_cancel_right' complex_eq diff_zero legacy_Complex_simps(15) nonzero_mult_div_cancel_right right_minus_eq times_divide_eq_left zero_complex.code)

text ‹Collinearity characterization using determinants›
lemma collinear_det:
  assumes "¬ collinear z1 z2 z3"
  shows "det2 (z3 - z1) (cnj (z3 - z1)) (z1 - z2) (cnj (z1 - z2))  0"
proof-
  from assms have "((z3 - z1) / (z2 - z1)) - cnj ((z3 - z1) / (z2 - z1))  0" "z2  z1"
    unfolding collinear_def
    using Complex_Im_express_cnj[of "(z3 - z1) / (z2 - z1)"]
    by (auto simp add: Complex_eq)
  thus ?thesis
    by (auto simp add: field_simps)
qed

text ‹Properties of three collinear points›

lemma collinear_sym1:
  shows "collinear z1 z2 z3  collinear z1 z3 z2"
  unfolding collinear_def
  using div_reals[of "1" "(z3 - z1)/(z2 - z1)"]  div_reals[of "1" "(z2 - z1)/(z3 - z1)"]
  by auto

lemma collinear_sym2':
  assumes "collinear z1 z2 z3"
  shows "collinear z2 z1 z3"
proof-
  obtain k where "z1 = z2  z3 - z1 = complex_of_real k * (z2 - z1)"
    using assms
    unfolding collinear_ex_real
    by auto
  thus ?thesis
  proof
    assume "z3 - z1 = complex_of_real k * (z2 - z1)"
    thus ?thesis
      unfolding collinear_ex_real
      by (rule_tac x="1-k" in exI) (auto simp add: field_simps)
  qed (simp add: collinear_def)
qed

lemma collinear_sym2:
  shows "collinear z1 z2 z3  collinear z2 z1 z3"
  using collinear_sym2'[of z1 z2 z3] collinear_sym2'[of z2 z1 z3]
  by auto

text ‹Properties of four collinear points›

lemma collinear_trans1:
  assumes "collinear z0 z2 z1" and "collinear z0 z3 z1" and "z0  z1"
  shows "collinear z0 z2 z3"
  using assms
  unfolding collinear_ex_real
  by (cases "z0 = z2", auto) (rule_tac x="k/ka" in exI, case_tac "ka = 0", auto simp add: field_simps)


(* ----------------------------------------------------------------- *)
subsection ‹Euclidean line›
(* ----------------------------------------------------------------- *)

text ‹Line is defined by using collinearity›
definition line :: "complex  complex  complex set" where
  "line z1 z2 = {z. collinear z1 z2 z}"

lemma line_points_collinear:
  assumes "z1  line z z'" and "z2  line z z'" and "z3  line z z'" and "z  z'"
  shows "collinear z1 z2 z3"
  using assms
  unfolding line_def
  by (smt collinear_sym1 collinear_sym2' collinear_trans1 mem_Collect_eq)

text ‹Parametric equation of a line›
lemma line_param:
  shows "z1 + cor k * (z2 - z1)  line z1 z2"
  unfolding line_def
  by (auto simp add: collinear_def)

text ‹Equation of the line containing two different given points›
lemma line_equation:
  assumes "z1  z2" and "μ = rot90 (z2 - z1)"
  shows "line z1 z2 = {z. cnj μ*z + μ*cnj z - (cnj μ * z1 + μ * cnj z1)  = 0}"
proof-
  {
    fix z
    have "z  line z1 z2  Im ((z - z1)/(z2 - z1)) = 0"
      using assms
      by (simp add: line_def collinear_def)
    also have "...  (z - z1)/(z2 - z1) = cnj ((z - z1)/(z2 - z1))"
      using complex_diff_cnj[of "(z - z1)/(z2 - z1)"]
      by auto
    also have "...  (z - z1)*(cnj z2 - cnj z1) = (cnj z - cnj z1)*(z2 - z1)"
      using assms(1)
      using (z  line z1 z2) = is_real ((z - z1) / (z2 - z1)) calculation is_real_div
      by auto
    also have "...  cnj(z2 - z1)*z - (z2 - z1)*cnj z - (cnj(z2 - z1)*z1 - (z2 - z1)*cnj z1) = 0"
      by (simp add: field_simps)
    also have "...  cnj μ * z + μ * cnj z  - (cnj μ * z1 + μ * cnj z1) = 0"
      apply (subst assms)+
      apply (subst cnj_mix_minus)+
      by simp
    finally have "z  line z1 z2  cnj μ * z + μ * cnj z  - (cnj μ * z1 + μ * cnj z1) = 0"
      .
  }
  thus ?thesis
    by auto
qed

(* -------------------------------------------------------------------------- *)
subsection ‹Euclidean circle›
(* -------------------------------------------------------------------------- *)

text ‹Definition of the circle with given center and radius. It consists of all
points on the distance $r$ from the center $\mu$.›
definition circle :: "complex  real  complex set" where
  "circle μ r = {z. cmod (z - μ) = r}"

text ‹Equation of the circle centered at $\mu$ with the radius $r$.›
lemma circle_equation:
  assumes "r  0"
  shows "circle μ r = {z. z*cnj z - z*cnj μ - cnj z*μ + μ*cnj μ - cor (r*r) = 0}"
proof (safe)
  fix z
  assume "z  circle μ r"
  hence "(z - μ)*cnj (z - μ) = complex_of_real (r*r)"
    unfolding circle_def
    using complex_mult_cnj_cmod[of "z - μ"]
    by (auto simp add: power2_eq_square)
  thus "z * cnj z - z * cnj μ - cnj z * μ + μ * cnj μ - cor (r * r) = 0"
    by (auto simp add: field_simps)
next
  fix z
  assume "z * cnj z - z * cnj μ - cnj z * μ + μ * cnj μ - cor (r * r) = 0"
  hence "(z - μ)*cnj (z - μ) = cor (r*r)"
    by (auto simp add: field_simps)
  thus "z  circle μ r"
    using assms
    using complex_mult_cnj_cmod[of "z - μ"]
    using power2_eq_imp_eq[of "cmod (z - μ)" r]
    unfolding circle_def power2_eq_square[symmetric] complex_of_real_def
    by auto
qed

(* -------------------------------------------------------------------------- *)
subsection ‹Circline›
(* -------------------------------------------------------------------------- *)

text ‹A very important property of the extended complex plane is that it is possible to treat circles
and lines in a uniform way. The basic object is \emph{generalized circle}, or \emph{circline} for
short. We introduce circline equation given in $\mathbb{C}$, and it will later be generalized to an
equation in the extended complex plane $\overline{\mathbb{C}}$ given in matrix form using a
Hermitean matrix and a quadratic form over homogenous coordinates.›

definition circline where
  "circline A BC D = {z. cor A*z*cnj z + cnj BC*z + BC*cnj z + cor D = 0}"

text ‹Connection between circline and Euclidean circle›

text ‹Every circline with positive determinant and $A \neq 0$ represents an Euclidean circle›

lemma circline_circle:
  assumes "A  0" and "A * D  (cmod BC)2"
  "cl = circline A BC D" and
  "μ = -BC/cor A" and 
  "r2 = ((cmod BC)2 - A*D) / A2" and "r = sqrt r2"
  shows "cl = circle μ r"
proof-
  have *: "cl = {z. z * cnj z + cnj (BC / cor A) * z + (BC / cor A) * cnj z + cor (D / A) = 0}"
    using cl = circline A BC D A  0
    by (auto simp add: circline_def field_simps)

  have "r2  0"
  proof-
    have "(cmod BC)2 - A * D   0"
      using A * D  (cmod BC)2
      by auto
    thus ?thesis
      using A  0 r2 = ((cmod BC)2 - A*D) / A2
      by (metis zero_le_divide_iff zero_le_power2)
  qed
  hence **: "r * r = r2" "r  0"
    using r = sqrt r2
    by (auto simp add: real_sqrt_mult[symmetric])

  have ***: "- μ * - cnj μ - cor r2 = cor (D / A)"
    using μ = - BC / complex_of_real A r2 = ((cmod BC)2 - A * D) / A2
    by (auto simp add: power2_eq_square complex_mult_cnj_cmod field_simps)
       (simp add: add_divide_eq_iff assms(1))
  thus ?thesis
    using r2 = ((cmod BC)2 - A*D) / A2 μ = - BC / cor A
    by (subst *, subst circle_equation[of r μ, OF r  0], subst **) (auto simp add: field_simps power2_eq_square)
qed

lemma circline_ex_circle:
  assumes "A  0" and "A * D  (cmod BC)2" and "cl = circline A BC D"
  shows " μ r. cl = circle μ r"
  using circline_circle[OF assms]
  by auto

text ‹Every Euclidean circle can be represented by a circline›

lemma circle_circline:
  assumes "cl = circle μ r" and "r  0"
  shows "cl = circline 1 (-μ) ((cmod μ)2 - r2)"
proof-
  have "complex_of_real ((cmod μ)2 - r2) = μ * cnj μ - complex_of_real (r2)"
    by (auto simp add: complex_mult_cnj_cmod)
  thus "cl = circline 1 (- μ) ((cmod μ)2 - r2)"
    using assms
    using circle_equation[of r μ]
    unfolding circline_def power2_eq_square
    by (simp add: field_simps)
qed

lemma circle_ex_circline:
  assumes "cl = circle μ r" and "r  0"
  shows " A BC D. A  0  A*D  (cmod BC)2  cl = circline A BC D"
  using circle_circline[OF assms]
  using r  0
  by (rule_tac x=1 in exI, rule_tac x="-μ" in exI, rule_tac x="Re (μ * cnj μ) - (r * r)" in exI) (simp add: complex_mult_cnj_cmod power2_eq_square)

text ‹Connection between circline and Euclidean line›

text ‹Every circline with a positive determinant and $A = 0$ represents an Euclidean line›

lemma circline_line:
  assumes
    "A = 0" and "BC  0" and
    "cl = circline A BC D" and
    "z1 = - cor D * BC / (2 * BC * cnj BC)" and
    "z2 = z1 + 𝗂 * sgn (if arg BC > 0 then -BC else BC)"
  shows
    "cl = line z1 z2"
proof-
  have "cl = {z. cnj BC*z + BC*cnj z + complex_of_real D = 0}"
    using assms
    by (simp add: circline_def)
    have "{z. cnj BC*z + BC*cnj z + complex_of_real D = 0} =
          {z. cnj BC*z + BC*cnj z - (cnj BC*z1 + BC*cnj z1) = 0}"
      using  BC  0 assms
      by simp
    moreover
    have "z1  z2"
      using BC  0 assms
      by (auto simp add: sgn_eq)
    moreover
    have " k. k  0  BC = cor k*rot90 (z2 - z1)"
    proof (cases "arg BC > 0")
      case True
      thus ?thesis
        using assms
        by (rule_tac x="(cmod BC)" in exI, auto simp add: Complex_scale4)
    next
      case False
      thus ?thesis
        using assms
        by (rule_tac x="-(cmod BC)" in exI, simp)
           (smt Complex.Re_sgn Im_sgn cis_arg complex_minus complex_surj mult_minus_right rcis_cmod_arg rcis_def)
    qed
    then obtain k where "cor k  0" "BC = cor k*rot90 (z2 - z1)"
      by auto
    moreover
    have *: " z. cnj_mix (BC / cor k) z - cnj_mix (BC / cor k) z1 = (1/cor k) * (cnj_mix BC z - cnj_mix BC z1)"
      using ‹cor k  0
      by (simp add: field_simps)
    hence "{z. cnj_mix BC z - cnj_mix BC z1 = 0} = {z. cnj_mix (BC / cor k) z - cnj_mix (BC / cor k) z1 = 0}"
      using ‹cor k  0
      by auto
    ultimately
    have "cl = line z1 z2"
      using line_equation[of z1 z2 "BC/cor k"] cl = {z. cnj BC*z + BC*cnj z + complex_of_real D = 0}
      by auto
    thus ?thesis
      using z1  z2
      by blast
qed

lemma circline_ex_line:
  assumes "A = 0" and "BC  0" and "cl = circline A BC D"
  shows " z1 z2. z1  z2  cl = line z1 z2"
proof-
  let ?z1 = "- cor D * BC / (2 * BC * cnj BC)"
  let ?z2 = "?z1 + 𝗂 * sgn (if 0 < arg BC then - BC else BC)"
  have "?z1  ?z2"
    using BC  0
    by (simp add: sgn_eq)
  thus ?thesis
    using circline_line[OF assms, of ?z1 ?z2] BC  0
    by (rule_tac x="?z1" in exI, rule_tac x="?z2" in exI, simp)
qed

text ‹Every Euclidean line can be represented by a circline›

lemma line_ex_circline:
  assumes "cl = line z1 z2" and "z1  z2"
  shows " BC D. BC  0  cl = circline 0 BC D"
proof-
  let ?BC = "rot90 (z2 - z1)"
  let ?D = "Re (- 2 * scalprod z1 ?BC)"
  show ?thesis
  proof (rule_tac x="?BC" in exI, rule_tac x="?D" in exI, rule conjI)
    show "?BC  0"
      using z1  z2 rot90_ii[of "z2 - z1"]
      by auto
  next
    have *: "complex_of_real (Re (- 2 * scalprod z1 (rot90 (z2 - z1)))) = - (cnj_mix z1 (rot90 (z2 - z1)))"
      using rot90_ii[of "z2 - z1"]
      by (cases z1, cases z2, simp add: Complex_eq field_simps)
    show "cl = circline 0 ?BC ?D"
      apply (subst assms, subst line_equation[of z1 z2 ?BC])
      unfolding circline_def
      by (fact, simp, subst *, simp add: field_simps)
  qed
qed

lemma circline_line':
  assumes "z1  z2"
  shows "circline 0 (𝗂 * (z2 - z1)) (Re (- cnj_mix (𝗂 * (z2 - z1)) z1)) = line z1 z2"
proof-
  let ?B = "𝗂 * (z2 - z1)"
  let ?D = "Re (- cnj_mix ?B z1)"
  have "circline 0 ?B ?D = {z. cnj ?B*z + ?B*cnj z + complex_of_real ?D = 0}"
    using assms
    by (simp add: circline_def)
  moreover
  have "is_real (- cnj_mix (𝗂 * (z2 - z1)) z1)"
    using cnj_mix_real[of ?B z1]
    by auto
  hence "{z. cnj ?B*z + ?B*cnj z + complex_of_real ?D = 0} =
         {z. cnj ?B*z + ?B*cnj z - (cnj ?B*z1 + ?B*cnj z1) = 0}"
    apply (subst complex_of_real_Re, simp)
    unfolding diff_conv_add_uminus
    by simp
  moreover
  have "line z1 z2 = {z. cnj_mix (𝗂 * (z2 - z1)) z - cnj_mix (𝗂 * (z2 - z1)) z1 = 0}"
    using line_equation[of z1 z2 ?B] assms
    unfolding rot90_ii
    by simp
  ultimately
  show ?thesis
    by simp
qed

(* ---------------------------------------------------------------------------- *)
subsection ‹Angle between two circles›
(* ---------------------------------------------------------------------------- *)

text ‹Given a center $\mu$ of an Euclidean circle and a point $E$ on it, we define the tangent vector
in $E$ as the radius vector $\overrightarrow{\mu E}$, rotated by $\pi/2$, clockwise or
counterclockwise, depending on the circle orientation. The Boolean @{term p} encodes the orientation
of the circle, and the function @{term "sgn_bool p"} returns $1$ when @{term p} is true, and
$-1$ when @{term p} is false.›

abbreviation sgn_bool where
  "sgn_bool p  if p then 1 else -1"

definition circ_tang_vec :: "complex  complex  bool  complex" where
  "circ_tang_vec μ E p = sgn_bool p * 𝗂 * (E - μ)"

text ‹Tangent vector is orthogonal to the radius.›
lemma circ_tang_vec_ortho:
  shows "scalprod (E - μ) (circ_tang_vec μ E p) = 0"
  unfolding circ_tang_vec_def Let_def
  by auto

text ‹Changing the circle orientation gives the opposite tangent vector.›
lemma circ_tang_vec_opposite_orient:
  shows "circ_tang_vec μ E p = - circ_tang_vec μ E (¬ p)"
  unfolding circ_tang_vec_def
  by auto

text ‹Angle between two oriented circles at their common point $E$ is defined as the angle between
tangent vectors at $E$. Again we define three different angle measures.›

text ‹The oriented angle between two circles at the point $E$. The first circle is
centered at $\mu_1$ and its orientation is given by the Boolean $p_1$, 
while the second circle is centered at $\mu_2$ and its orientation is given by 
the Boolea $p_2$.›
definition ang_circ where 
  "ang_circ E μ1 μ2 p1 p2 =  (circ_tang_vec μ1 E p1) (circ_tang_vec μ2 E p2)"

text ‹The unoriented angle between the two circles›
definition ang_circ_c where
  "ang_circ_c E μ1 μ2 p1 p2 = ∠c (circ_tang_vec μ1 E p1) (circ_tang_vec μ2 E p2)"

text ‹The acute angle between the two circles›
definition ang_circ_a where
  "ang_circ_a E μ1 μ2 p1 p2 = ∠a (circ_tang_vec μ1 E p1) (circ_tang_vec μ2 E p2)"

text ‹Explicit expression for oriented angle between two circles›
lemma ang_circ_simp:
  assumes "E  μ1" and "E  μ2"
  shows "ang_circ E μ1 μ2 p1 p2 =
         arg (E - μ2) - arg (E - μ1) + sgn_bool p1 * pi / 2 - sgn_bool p2 * pi / 2"
  unfolding ang_circ_def ang_vec_def circ_tang_vec_def
  apply (rule canon_ang_eq)
  using assms
  using arg_mult_2kpi[of "sgn_bool p2*𝗂" "E - μ2"]
  using arg_mult_2kpi[of "sgn_bool p1*𝗂" "E - μ1"]
  apply auto
     apply (rule_tac x="x-xa" in exI, auto simp add: field_simps)
    apply (rule_tac x="-1+x-xa" in exI, auto simp add: field_simps)
   apply (rule_tac x="1+x-xa" in exI, auto simp add: field_simps)
  apply (rule_tac x="x-xa" in exI, auto simp add: field_simps)
  done

text ‹Explicit expression for the cosine of angle between two circles›
lemma cos_ang_circ_simp:
  assumes "E  μ1" and "E  μ2"
  shows "cos (ang_circ E μ1 μ2 p1 p2) =
         sgn_bool (p1 = p2) * cos (arg (E - μ2) - arg (E - μ1))"
  using assms
  using cos_periodic_pi2[of "arg (E - μ2) - arg (E - μ1)"]
  using cos_minus_pi[of "arg (E - μ2) - arg (E - μ1)"]
  using ang_circ_simp[OF assms, of p1 p2]
  by auto

text ‹Explicit expression for the unoriented angle between two circles›
lemma ang_circ_c_simp:
  assumes "E  μ1" and "E  μ2"
  shows "ang_circ_c E μ1 μ2 p1 p2 = 
        ¦arg (E - μ2) - arg (E - μ1) + sgn_bool p1 * pi / 2 - sgn_bool p2 * pi / 2¦"
  unfolding ang_circ_c_def ang_vec_c_def
  using ang_circ_simp[OF assms]
  unfolding ang_circ_def
  by auto

text ‹Explicit expression for the acute angle between two circles›
lemma ang_circ_a_simp:
  assumes "E  μ1" and "E  μ2"
  shows "ang_circ_a E μ1 μ2 p1 p2 = 
         acute_ang (abs (canon_ang (arg(E - μ2) - arg(E - μ1) + (sgn_bool p1) * pi/2 - (sgn_bool p2) * pi/2)))"
  unfolding ang_circ_a_def ang_vec_a_def
  using ang_circ_c_simp[OF assms]
  unfolding ang_circ_c_def
  by auto

text ‹Acute angle between two circles does not depend on the circle orientation.›
lemma ang_circ_a_pTrue:
  assumes "E  μ1" and "E  μ2"
  shows "ang_circ_a E μ1 μ2 p1 p2 = ang_circ_a E μ1 μ2 True True"
proof (cases "p1")
  case True
  show ?thesis
  proof (cases "p2")
    case True
    show ?thesis
      using p1 p2
      by simp
  next
    case False
    show ?thesis
      using p1 ¬ p2
      unfolding ang_circ_a_def
      using circ_tang_vec_opposite_orient[of μ2 E p2]
      using ang_vec_a_opposite2
      by simp
  qed
next
  case False
  show ?thesis
  proof (cases "p2")
    case True
    show ?thesis
      using ¬ p1 p2
      unfolding ang_circ_a_def
      using circ_tang_vec_opposite_orient[of μ1 E p1]
      using ang_vec_a_opposite1
      by simp
  next
    case False
    show ?thesis
      using ¬ p1 ¬ p2
      unfolding ang_circ_a_def
      using circ_tang_vec_opposite_orient[of μ1 E p1] circ_tang_vec_opposite_orient[of μ2 E p2]
      using ang_vec_a_opposite1  ang_vec_a_opposite2
      by simp
  qed
qed

text ‹Definition of the acute angle between the two unoriented circles ›
abbreviation ang_circ_a' where
  "ang_circ_a' E μ1 μ2  ang_circ_a E μ1 μ2 True True"

text ‹A very simple expression for the acute angle between the two circles›
lemma ang_circ_a_simp1:
  assumes "E  μ1" and "E  μ2"
  shows "ang_circ_a E μ1 μ2 p1 p2 = ∠a (E - μ1) (E - μ2)"
  unfolding ang_vec_a_def ang_vec_c_def ang_vec_def
  by (subst ang_circ_a_pTrue[OF assms, of p1 p2], subst ang_circ_a_simp[OF assms, of True True]) (metis add_diff_cancel)

lemma ang_circ_a'_simp:
  assumes "E  μ1" and "E  μ2"
  shows "ang_circ_a' E μ1 μ2 = ∠a (E - μ1) (E - μ2)"
  by (rule ang_circ_a_simp1[OF assms])

end

Theory Homogeneous_Coordinates

(* ---------------------------------------------------------------------------- *)
section ‹Homogeneous coordinates in extended complex plane›
(* ---------------------------------------------------------------------------- *)

text ‹Extended complex plane $\mathbb{\overline{C}}$ is complex plane with an additional element 
(treated as the infinite point). The extended complex plane $\mathbb{\overline{C}}$ is identified 
with a complex projective line (the one-dimensional projective space over the complex field, sometimes denoted by $\mathbb{C}P^1$).
Each point of $\mathbb{\overline{C}}$ is represented by a pair of complex homogeneous coordinates (not
both equal to zero), and two pairs of homogeneous coordinates represent the same
point in $\mathbb{\overline{C}}$ iff they are proportional by a non-zero complex factor.›

theory Homogeneous_Coordinates
imports More_Complex Matrices
begin

(* ---------------------------------------------------------------------------- *)
subsection ‹Definition of homogeneous coordinates›
(* ---------------------------------------------------------------------------- *)

text ‹Two complex vectors are equivalent iff they are proportional.›

definition complex_cvec_eq :: "complex_vec  complex_vec  bool" (infix "v" 50)  where
  [simp]: "z1 v z2  ( k. k  (0::complex)  z2 = k *sv z1)"

lemma complex_cvec_eq_mix:
  assumes "(z1, z2)  vec_zero" and "(w1, w2)  vec_zero"
  shows "(z1, z2) v (w1, w2)  z1*w2 = z2*w1"
proof safe
  assume "(z1, z2) v (w1, w2)"
  thus "z1 * w2 = z2 * w1"
    by auto
next
  assume *: "z1 * w2 = z2 * w1"
  show "(z1, z2) v (w1, w2)"
  proof (cases "z2 = 0")
    case True
    thus ?thesis
      using * assms
      by auto
  next
    case False
    hence "w1 = (w2/z2)*z1  w2 = (w2/z2)*z2" "w2/z2  0"
      using * assms
      by (auto simp add: field_simps)
    thus "(z1, z2) v (w1, w2)"
      by (metis complex_cvec_eq_def mult_sv.simps)
  qed
qed

lemma complex_eq_cvec_reflp [simp]:
  shows "reflp (≈v)"
  unfolding reflp_def complex_cvec_eq_def
  by safe (rule_tac x="1" in exI, simp)

lemma complex_eq_cvec_symp [simp]:
  shows "symp (≈v)"
  unfolding symp_def complex_cvec_eq_def
  by safe (rule_tac x="1/k" in exI, simp)

lemma complex_eq_cvec_transp [simp]:
  shows "transp (≈v)"
  unfolding transp_def complex_cvec_eq_def
  by safe (rule_tac x="k*ka" in exI, simp)

lemma complex_eq_cvec_equivp [simp]:
  shows "equivp (≈v)"
  by (auto intro: equivpI)

text ‹Non-zero pairs of complex numbers (also treated as non-zero complex vectors)›

typedef complex_homo_coords = "{v::complex_vec. v  vec_zero}"
  by (rule_tac x="(1, 0)" in exI, simp)

setup_lifting type_definition_complex_homo_coords

lift_definition complex_homo_coords_eq :: "complex_homo_coords  complex_homo_coords  bool" (infix "" 50) is complex_cvec_eq
  done

lemma complex_homo_coords_eq_reflp [simp]:
  shows "reflp (≈)"
  using complex_eq_cvec_reflp
  unfolding reflp_def
  by transfer blast

lemma complex_homo_coords_eq_symp [simp]:
  shows "symp (≈)"
  using complex_eq_cvec_symp
  unfolding symp_def
  by transfer blast

lemma complex_homo_coords_eq_transp [simp]: 
  shows "transp (≈)"
  using complex_eq_cvec_transp
  unfolding transp_def
  by transfer blast

lemma complex_homo_coords_eq_equivp:
  shows "equivp (≈)"
  by (auto intro: equivpI)

lemma complex_homo_coords_eq_refl [simp]:
  shows "z  z"
  using complex_homo_coords_eq_reflp
  unfolding reflp_def refl_on_def
  by blast

lemma complex_homo_coords_eq_sym:
  assumes "z1  z2"
  shows "z2  z1"
  using assms complex_homo_coords_eq_symp
  unfolding symp_def
  by blast

lemma complex_homo_coords_eq_trans:
  assumes "z1  z2" and "z2  z3"
  shows "z1  z3"
  using assms complex_homo_coords_eq_transp
  unfolding transp_def
  by blast

text ‹Quotient type of homogeneous coordinates›
quotient_type
  complex_homo = complex_homo_coords / "complex_homo_coords_eq"
  by (rule complex_homo_coords_eq_equivp)


(* ---------------------------------------------------------------------------- *)
subsection ‹Some characteristic points in $\mathbb{C}P^1$›
(* ---------------------------------------------------------------------------- *)

text ‹Infinite point›
definition inf_cvec :: "complex_vec" ("v") where
  [simp]: "inf_cvec = (1, 0)"
lift_definition inf_hcoords :: "complex_homo_coords"  ("hc") is inf_cvec
  by simp
lift_definition inf :: "complex_homo"  ("h")  is inf_hcoords
done

lemma inf_cvec_z2_zero_iff:
  assumes "(z1, z2)  vec_zero"
  shows "(z1, z2) v v  z2 = 0"
  using assms
  by auto

text ‹Zero›
definition zero_cvec :: "complex_vec" ("0v") where
  [simp]: "zero_cvec = (0, 1)"
lift_definition zero_hcoords :: "complex_homo_coords" ("0hc") is zero_cvec
  by simp
lift_definition zero :: "complex_homo" ("0h") is zero_hcoords
  done

lemma zero_cvec_z1_zero_iff:
  assumes "(z1, z2)  vec_zero"
  shows "(z1, z2) v 0v  z1 = 0"
  using assms
  by auto

text ‹One›
definition one_cvec :: "complex_vec" ("1v")where
  [simp]: "one_cvec = (1, 1)"
lift_definition one_hcoords :: "complex_homo_coords" ("1hc") is one_cvec
  by simp
lift_definition one :: "complex_homo" ("1h") is one_hcoords
  done

lemma zero_one_infty_not_equal [simp]:
  shows "1h  h" and "0h  h" and "0h  1h" and "1h  0h" and "h  0h" and "h  1h"
  by (transfer, transfer, simp)+

text ‹Imaginary unit›
definition ii_cvec :: "complex_vec" ("iiv") where
  [simp]: "ii_cvec = (𝗂, 1)"
lift_definition ii_hcoords :: "complex_homo_coords" ("iihc") is ii_cvec
  by simp
lift_definition ii :: "complex_homo" ("iih") is ii_hcoords
  done

lemma ex_3_different_points:
  fixes z::complex_homo
  shows " z1 z2. z  z1  z1  z2  z  z2"
proof (cases "z  0h  z  1h")
  case True
  thus ?thesis
    by (rule_tac x="0h" in exI, rule_tac x="1h" in exI, auto)
next
  case False
  hence "z = 0h  z = 1h"
    by simp
  thus ?thesis
  proof
    assume "z = 0h"
    thus ?thesis
      by (rule_tac x="h" in exI, rule_tac x="1h" in exI, auto)
  next
    assume "z = 1h"
    thus ?thesis
      by (rule_tac x="h" in exI, rule_tac x="0h" in exI, auto)
  qed
qed

(* ---------------------------------------------------------------------------- *)
subsection ‹Connection to ordinary complex plane $\mathbb{C}$›
(* ---------------------------------------------------------------------------- *)

text ‹Conversion from complex›

definition of_complex_cvec :: "complex  complex_vec" where
  [simp]: "of_complex_cvec z = (z, 1)"
lift_definition of_complex_hcoords :: "complex  complex_homo_coords" is of_complex_cvec
  by simp
lift_definition of_complex :: "complex  complex_homo" is of_complex_hcoords
  done

lemma of_complex_inj:
  assumes "of_complex x = of_complex y"
  shows "x = y"
  using assms
  by (transfer, transfer, simp)

lemma of_complex_image_inj:
  assumes "of_complex ` A = of_complex ` B"
  shows "A = B"
  using assms
  using of_complex_inj
  by auto

lemma of_complex_not_inf [simp]:
  shows "of_complex x  h"
  by (transfer, transfer, simp)

lemma inf_not_of_complex [simp]:
  shows "h  of_complex x"
  by (transfer, transfer, simp)

lemma inf_or_of_complex:
  shows "z = h  ( x. z = of_complex x)"
proof (transfer, transfer)
  fix z :: complex_vec
  obtain z1 z2 where *: "z = (z1, z2)"
    by (cases z) auto
  assume "z  vec_zero"
  thus "z v v  (x. z v of_complex_cvec x)"
    using *
    by (cases "z2 = 0", auto)
qed

lemma of_complex_zero [simp]:
  shows "of_complex 0 = 0h"
  by (transfer, transfer, simp)

lemma of_complex_one [simp]:
  shows "of_complex 1 = 1h"
  by (transfer, transfer, simp)

lemma of_complex_ii [simp]:
  shows "of_complex 𝗂 = iih"
  by (transfer, transfer, simp)

lemma of_complex_zero_iff [simp]:
  shows "of_complex x = 0h  x = 0"
  by (subst of_complex_zero[symmetric]) (auto simp add: of_complex_inj)

lemma of_complex_one_iff [simp]:
  shows "of_complex x = 1h  x = 1"
  by (subst of_complex_one[symmetric]) (auto simp add: of_complex_inj)

lemma of_complex_ii_iff [simp]:
  shows "of_complex x = iih  x = 𝗂"
  by (subst of_complex_ii[symmetric]) (auto simp add: of_complex_inj)

text ‹Conversion to complex›

definition to_complex_cvec :: "complex_vec  complex" where
  [simp]: "to_complex_cvec z = (let (z1, z2) = z in z1/z2)"
lift_definition to_complex_homo_coords :: "complex_homo_coords  complex" is to_complex_cvec
  done
lift_definition to_complex :: "complex_homo  complex" is to_complex_homo_coords
proof-
  fix z w
  assume "z  w"
  thus "to_complex_homo_coords z = to_complex_homo_coords w"
    by transfer auto
qed

lemma to_complex_of_complex [simp]:
  shows "to_complex (of_complex z) = z"
  by (transfer, transfer, simp)

lemma of_complex_to_complex [simp]:
  assumes "z  h"
  shows "(of_complex (to_complex z)) = z"
  using assms
proof (transfer, transfer)
  fix z :: complex_vec
  obtain z1 z2 where *: "z = (z1, z2)"
    by (cases z, auto)
  assume "z  vec_zero" "¬ z v v"
  hence "z2  0"
    using *
    by (simp, erule_tac x="1/z1" in allE, auto)
  thus "(of_complex_cvec (to_complex_cvec z)) v z"
    using *
    by simp
qed

lemma to_complex_zero_zero [simp]:
  shows "to_complex 0h = 0"
  by (metis of_complex_zero to_complex_of_complex)

lemma to_complex_one_one [simp]:
  shows "to_complex 1h = 1"
  by (metis of_complex_one to_complex_of_complex)

lemma to_complex_img_one [simp]:
  shows "to_complex iih = 𝗂"
  by (metis of_complex_ii to_complex_of_complex)

(* ---------------------------------------------------------------------------- *)
subsection ‹Arithmetic operations›
(* ---------------------------------------------------------------------------- *)

text ‹Due to the requirement of HOL that all functions are total, we could not define the function
only for the well-defined cases, and in the lifting proofs we must also handle the ill-defined
cases. For example, $\infty_h +_h \infty_h$ is ill-defined, but we must define it, so we define it
arbitrarily to be $\infty_h$.›

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Addition›
(* ---------------------------------------------------------------------------- *)

text ‹$\infty_h\ +_h\ \infty_h$ is ill-defined. Since functions must be total, for formal reasons we
define it arbitrarily to be $\infty_h$.›

definition add_cvec :: "complex_vec  complex_vec  complex_vec" (infixl "+v" 60) where
  [simp]: "add_cvec z w = (let (z1, z2) = z; (w1, w2) = w
                                in if z2  0  w2  0 then
                                      (z1*w2 + w1*z2, z2*w2)
                                   else
                                      (1, 0))"
lift_definition add_hcoords :: "complex_homo_coords  complex_homo_coords  complex_homo_coords" (infixl "+hc" 60) is add_cvec
  by (auto split: if_split_asm)

lift_definition add :: "complex_homo  complex_homo  complex_homo" (infixl "+h" 60) is add_hcoords
proof transfer
  fix z w z' w' :: complex_vec
  obtain z1 z2 w1 w2 z'1 z'2 w'1 w'2 where
    *: "z = (z1, z2)" "w = (w1, w2)" "z' = (z'1, z'2)" "w' = (w'1, w'2)"
    by (cases z, auto, cases w, auto, cases z', auto, cases w', auto)
  assume **:
         "z  vec_zero" "w  vec_zero" "z v z'"
         "z'  vec_zero" "w'  vec_zero" "w v w'"
  show "z +v w v z' +v w'"
  proof (cases "z2  0  w2  0")
    case True
    hence "z'2  0  w'2  0"
      using * **
      by auto
    show ?thesis
      using z2  0  w2  0 z'2  0  w'2  0
      using * **
      by simp ((erule exE)+, rule_tac x="k*ka" in exI, simp add: field_simps)
  next
    case False
    hence "z'2 = 0  w'2 = 0"
      using * **
      by auto
    show ?thesis
      using ¬ (z2  0  w2  0) z'2 = 0  w'2 = 0
      using * **
      by auto
  qed
qed

lemma add_commute:
  shows "z +h w = w +h z"
  apply (transfer, transfer)
  unfolding complex_cvec_eq_def
  by (rule_tac x="1" in exI, auto split: if_split_asm)

lemma add_zero_right [simp]:
  shows "z +h 0h = z"
  by (transfer, transfer, force)

lemma add_zero_left [simp]:
  shows "0h +h z = z"
  by (subst add_commute) simp

lemma of_complex_add_of_complex [simp]:
  shows "(of_complex x) +h (of_complex y) = of_complex (x + y)"
  by (transfer, transfer, simp)

lemma of_complex_add_inf [simp]:
  shows "(of_complex x) +h h = h"
  by (transfer, transfer, simp)

lemma inf_add_of_complex [simp]:
  shows "h +h (of_complex x) = h"
  by (subst add_commute) simp

lemma inf_add_right:
  assumes "z  h"
  shows "z +h h = h"
  using assms
  using inf_or_of_complex[of z]
  by auto

lemma inf_add_left:
  assumes "z  h"
  shows "h +h z = h"
  using assms
  by (subst add_commute) (rule inf_add_right, simp)

text ‹This is ill-defined, but holds by our definition›
lemma inf_add_inf:
  shows "h +h h = h"
  by (transfer, transfer, simp)

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Unary minus›
(* ---------------------------------------------------------------------------- *)

definition uminus_cvec :: "complex_vec  complex_vec" ("~v") where
  [simp]: "~v z = (let (z1, z2) = z in (-z1, z2))"
lift_definition uminus_hcoords :: "complex_homo_coords  complex_homo_coords" ("~hc") is uminus_cvec
  by auto
lift_definition uminus :: "complex_homo  complex_homo" ("~h") is uminus_hcoords
  by transfer auto

lemma uminus_of_complex [simp]:
  shows "~h (of_complex z) = of_complex (-z)"
  by (transfer, transfer, simp)

lemma uminus_zero [simp]:
  shows "~h 0h = 0h"
  by (transfer, transfer, simp)

lemma uminus_inf [simp]:
  shows "~h h = h"
  apply (transfer, transfer)
  unfolding complex_cvec_eq_def
  by (rule_tac x="-1" in exI, simp)

lemma uminus_inf_iff:
  shows "~h z = h  z = h"
  apply (transfer, transfer)
  by auto (rule_tac x="-1/a" in exI, auto)

lemma uminus_id_iff:
  shows "~h z = z  z = 0h  z = h"
  apply (transfer, transfer)
  apply auto
   apply (erule_tac x="1/a" in allE, simp)
  apply (rule_tac x="-1" in exI, simp)
  done


(* ---------------------------------------------------------------------------- *)
subsubsection ‹Subtraction›
(* ---------------------------------------------------------------------------- *)

text ‹Operation $\infty_h\ -_h\ \infty_h$ is ill-defined, but we define it arbitrarily to $0_h$. It breaks the connection between
   subtraction with addition and unary minus, but seems more intuitive.›

definition sub :: "complex_homo  complex_homo  complex_homo" (infixl "-h" 60) where
  "z -h w = (if z = h  w = h then 0h else z +h (~h w))"

lemma of_complex_sub_of_complex [simp]:
  shows "(of_complex x) -h (of_complex y) = of_complex (x - y)"
  unfolding sub_def
  by simp

lemma zero_sub_right[simp]:
  shows "z -h 0h = z"
  unfolding sub_def
  by simp

lemma zero_sub_left[simp]:
  shows "0h -h of_complex x = of_complex (-x)"
  by (subst of_complex_zero[symmetric], simp del: of_complex_zero)

lemma zero_sub_one[simp]:
  shows "0h -h 1h = of_complex (-1)"
  by (metis of_complex_one zero_sub_left)

lemma of_complex_sub_one [simp]:
  shows "of_complex x -h 1h = of_complex (x - 1)"
  by (metis of_complex_one of_complex_sub_of_complex)

lemma sub_eq_zero [simp]:
  assumes "z  h"
  shows "z -h z = 0h"
  using assms
  using inf_or_of_complex[of z]
  by auto

lemma sub_eq_zero_iff:
  assumes "z  h  w  h"
  shows "z -h w = 0h  z = w"
proof
  assume "z -h w = 0h"
  thus "z = w"
    using assms
    unfolding sub_def
  proof (transfer, transfer)
    fix z w :: complex_vec
    obtain z1 z2 w1 w2 where *: "z = (z1, z2)" "w = (w1, w2)"
      by (cases z, auto, cases w, auto)
    assume "z  vec_zero" "w  vec_zero" "¬ z v v  ¬ w v v" and
           **: "(if z v v  w v v then 0v else z +v ~v w) v 0v"
    have "z2  0  w2  0"
      using * ¬ z v v  ¬ w v v z  vec_zero› w  vec_zero›
      apply auto
       apply (erule_tac x="1/z1" in allE, simp)
      apply (erule_tac x="1/w1" in allE, simp)
      done

    thus "z v w"
      using * **
      by simp (rule_tac x="w2/z2" in exI, auto simp add: field_simps)
  qed
next
  assume "z = w"
  thus "z -h w = 0h"
    using sub_eq_zero[of z] assms
    by auto
qed

lemma inf_sub_left [simp]:
  assumes "z  h"
  shows "h -h z = h"
  using assms
  using uminus_inf_iff
  using inf_or_of_complex
  unfolding sub_def
  by force

lemma inf_sub_right [simp]:
  assumes "z  h"
  shows "z -h h = h"
  using assms
  using inf_or_of_complex
  unfolding sub_def
  by force

text ‹This is ill-defined, but holds by our definition›
lemma inf_sub_inf:
  shows "h -h h = 0h"
  unfolding sub_def
  by simp

lemma sub_noteq_inf:
  assumes "z  h" and "w  h"
  shows "z -h w  h"
  using assms
  using inf_or_of_complex[of z]
  using inf_or_of_complex[of w]
  using inf_or_of_complex[of "z -h w"]
  using of_complex_sub_of_complex
  by auto

lemma sub_eq_inf:
  assumes "z -h w = h"
  shows "z = h  w = h"
  using assms sub_noteq_inf
  by blast

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Multiplication›
(* ---------------------------------------------------------------------------- *)

text ‹Operations $0_h \cdot_h \infty_h$ and $\infty_h \cdot_h 0_h$ are ill defined. Since all
functions must be total, for formal reasons we define it arbitrarily to be $1_h$.›

definition mult_cvec :: "complex_vec  complex_vec  complex_vec" (infixl "*v" 70) where
 [simp]: "z *v w = (let (z1, z2) = z; (w1, w2) = w
                     in if (z1 = 0  w2 = 0)  (w1 = 0  z2 = 0) then
                          (1, 1)
                        else
                          (z1*w1, z2*w2))"
lift_definition mult_hcoords :: "complex_homo_coords  complex_homo_coords  complex_homo_coords" (infixl "*hc" 70) is mult_cvec
  by (auto split: if_split_asm)

lift_definition mult :: "complex_homo  complex_homo  complex_homo" (infixl "*h" 70) is mult_hcoords
proof transfer
  fix z w z' w' :: complex_vec
  obtain z1 z2 w1 w2 z'1 z'2 w'1 w'2 where
    *: "z = (z1, z2)" "w = (w1, w2)" "z' = (z'1, z'2)" "w' = (w'1, w'2)"
    by (cases z, auto, cases w, auto, cases z', auto, cases w', auto)
  assume **:
         "z  vec_zero" "w  vec_zero" "z v z'"
         "z'  vec_zero" "w'  vec_zero" "w v w'"
  show "z *v w v z' *v w'"
  proof (cases "(z1 = 0  w2 = 0)  (w1 = 0  z2 = 0)")
    case True
    hence "(z'1 = 0  w'2 = 0)  (w'1 = 0  z'2 = 0)"
      using * **
      by auto
    show ?thesis
      using (z1 = 0  w2 = 0)  (w1 = 0  z2 = 0) (z'1 = 0  w'2 = 0)  (w'1 = 0  z'2 = 0)
      using * **
      by simp
  next
    case False
    hence "¬((z'1 = 0  w'2 = 0)  (w'1 = 0  z'2 = 0))"
      using * **
      by auto
    hence ***: "z *v w = (z1*w1, z2*w2)" "z' *v w' = (z'1*w'1, z'2*w'2)"
      using ¬((z1 = 0  w2 = 0)  (w1 = 0  z2 = 0)) ¬((z'1 = 0  w'2 = 0)  (w'1 = 0  z'2 = 0))
      using *
      by auto
    show ?thesis
      apply (subst ***)+
      using * **
      by simp ((erule exE)+, rule_tac x="k*ka" in exI, simp)
  qed
qed

lemma of_complex_mult_of_complex [simp]:
  shows "(of_complex z1) *h (of_complex z2) = of_complex (z1 * z2)"
  by (transfer, transfer, simp)

lemma mult_commute:
  shows "z1 *h z2 = z2 *h z1"
  apply (transfer, transfer)
  unfolding complex_cvec_eq_def
  by (rule_tac x="1" in exI, auto split: if_split_asm)

lemma mult_zero_left [simp]:
  assumes "z  h"
  shows "0h *h z = 0h"
  using assms
proof (transfer, transfer)
  fix z :: complex_vec
  obtain z1 z2 where *: "z = (z1, z2)"
    by (cases z, auto)
  assume "z  vec_zero" "¬ (z v v)"
  hence "z2  0"
    using *
    by force
  thus "0v *v z v 0v"
    using *
    by simp
qed

lemma mult_zero_right [simp]:
  assumes "z  h"
  shows "z *h 0h = 0h"
  using mult_zero_left[OF assms]
  by (simp add: mult_commute)

lemma mult_inf_right [simp]:
  assumes "z  0h"
  shows "z *h h = h"
using assms
proof (transfer, transfer)
  fix z :: complex_vec
  obtain z1 z2 where *: "z = (z1, z2)"
    by (cases z, auto)
  assume "z  vec_zero" "¬ (z v 0v)"
  hence "z1  0"
    using *
    by force
  thus "z *v v v v"
    using *
    by simp
qed

lemma mult_inf_left [simp]:
  assumes "z  0h"
  shows "h *h z = h"
  using mult_inf_right[OF assms]
  by (simp add: mult_commute)

lemma mult_one_left [simp]:
  shows "1h *h z = z"
  by (transfer, transfer, force)

lemma mult_one_right [simp]:
  shows "z *h 1h = z"
  using mult_one_left[of z]
  by (simp add: mult_commute)

text ‹This is ill-defined, but holds by our definition›
lemma inf_mult_zero:
  shows "h *h 0h = 1h"
  by (transfer, transfer, simp)
lemma zero_mult_inf: 
  shows "0h *h h = 1h"
  by (transfer, transfer, simp)

lemma mult_eq_inf:
  assumes "z *h w = h"
  shows "z = h  w = h"
  using assms
  using inf_or_of_complex[of z]
  using inf_or_of_complex[of w]
  using inf_or_of_complex[of "z *h w"]
  using of_complex_mult_of_complex
  by auto

lemma mult_noteq_inf:
  assumes "z  h" and "w  h"
  shows "z *h w  h"
  using assms mult_eq_inf
  by blast

subsubsection ‹Reciprocal›
definition reciprocal_cvec :: "complex_vec  complex_vec" where
  [simp]: "reciprocal_cvec z = (let (z1, z2) = z in (z2, z1))"
lift_definition reciprocal_hcoords :: "complex_homo_coords  complex_homo_coords" is reciprocal_cvec
  by auto

lift_definition reciprocal :: "complex_homo  complex_homo" is reciprocal_hcoords
  by transfer auto

lemma reciprocal_involution [simp]: "reciprocal (reciprocal z) = z"
  by (transfer, transfer, auto)

lemma reciprocal_zero [simp]: "reciprocal 0h = h"
  by (transfer, transfer, simp)

lemma reciprocal_inf [simp]: "reciprocal h = 0h"
  by (transfer, transfer, simp)

lemma reciprocal_one [simp]: "reciprocal 1h = 1h"
  by (transfer, transfer, simp)

lemma reciprocal_inf_iff [iff]: "reciprocal z = h  z = 0h"
  by (transfer, transfer, auto)

lemma reciprocal_zero_iff [iff]: "reciprocal z = 0h  z = h"
  by (transfer, transfer, auto)

lemma reciprocal_of_complex [simp]:
  assumes "z  0"
  shows "reciprocal (of_complex z) = of_complex (1 / z)"
  using assms
  by (transfer, transfer, simp)

lemma reciprocal_real:
  assumes "is_real (to_complex z)" and "z  0h" and "z  h"
  shows "Re (to_complex (reciprocal z)) = 1 / Re (to_complex z)"
proof-
  obtain c where "z = of_complex c" "c  0" "is_real c"
    using assms inf_or_of_complex[of z]
    by auto
  thus ?thesis
    by (simp add: Re_divide_real)
qed

lemma reciprocal_id_iff: 
  shows "reciprocal z = z  z = of_complex 1  z = of_complex (-1)"
proof (cases "z = 0h")
  case True
  thus ?thesis
    by (metis inf_not_of_complex of_complex_zero_iff reciprocal_inf_iff zero_neq_neg_one zero_neq_one)
next
  case False
  thus ?thesis
    using inf_or_of_complex[of z]
    by (smt complex_sqrt_1 of_complex_zero_iff reciprocal_inf_iff reciprocal_of_complex to_complex_of_complex)
qed


(* ---------------------------------------------------------------------------- *)
subsubsection ‹Division›
(* ---------------------------------------------------------------------------- *)

text ‹Operations $0_h :_h 0_h$ and $\infty_h :_h \infty_h$ are ill-defined. For formal reasons they
are defined to be $1_h$ (by the definition of multiplication).›

definition divide :: "complex_homo  complex_homo  complex_homo" (infixl ":h" 70) where
  "x :h y = x *h (reciprocal y)"

lemma divide_zero_right [simp]:
  assumes "z  0h"
  shows "z :h 0h = h"
  using assms
  unfolding divide_def
  by simp

lemma divide_zero_left [simp]:
  assumes "z  0h"
  shows "0h :h z = 0h"
  using assms
  unfolding divide_def
  by simp

lemma divide_inf_right [simp]:
  assumes "z  h"
  shows "z :h h = 0h"
  using assms
  unfolding divide_def
  by simp

lemma divide_inf_left [simp]:
  assumes "z  h"
  shows "h :h z = h"
  using assms reciprocal_zero_iff[of z] mult_inf_left
  unfolding divide_def
  by simp

lemma divide_eq_inf:
  assumes "z :h w = h"
  shows "z = h  w = 0h"
  using assms
  using reciprocal_inf_iff[of w] mult_eq_inf
  unfolding divide_def
  by auto

lemma inf_divide_zero [simp]:
  shows "h :h 0h = h"
  unfolding divide_def
  by (transfer, simp)

lemma zero_divide_inf [simp]:
  shows "0h :h h =  0h"
  unfolding divide_def
  by (transfer, simp)

lemma divide_one_right [simp]:
  shows "z :h 1h = z"
  unfolding divide_def
  by simp

lemma of_complex_divide_of_complex [simp]:
  assumes "z2  0"
  shows "(of_complex z1) :h (of_complex z2) = of_complex (z1 / z2)"
using assms
  unfolding divide_def
  apply transfer
  apply transfer
  by (simp, rule_tac x="1/z2" in exI, simp)

lemma one_div_of_complex [simp]:
  assumes "x  0"
  shows "1h :h of_complex x = of_complex (1 / x)"
  using assms
  unfolding divide_def
  by simp

text ‹ This is ill-defined, but holds by our definition›
lemma inf_divide_inf: 
  shows "h :h h = 1h"
  unfolding divide_def
  by (simp add: inf_mult_zero)

text ‹ This is ill-defined, but holds by our definition›
lemma zero_divide_zero:
  shows "0h :h 0h = 1h"
  unfolding divide_def
  by (simp add: zero_mult_inf)

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Conjugate›
(* ---------------------------------------------------------------------------- *)

definition conjugate_cvec :: "complex_vec  complex_vec" where
  [simp]: "conjugate_cvec z = vec_cnj z"
lift_definition conjugate_hcoords :: "complex_homo_coords  complex_homo_coords" is conjugate_cvec
  by (auto simp add: vec_cnj_def)
lift_definition conjugate :: "complex_homo  complex_homo" is conjugate_hcoords
  by transfer (auto simp add: vec_cnj_def)

lemma conjugate_involution [simp]:
  shows "conjugate (conjugate z) = z"
  by (transfer, transfer, auto)

lemma conjugate_conjugate_comp [simp]:
  shows "conjugate  conjugate = id"
  by (rule ext, simp)

lemma inv_conjugate [simp]:
  shows "inv conjugate = conjugate"
  using inv_unique_comp[of conjugate conjugate]
  by simp

lemma conjugate_of_complex [simp]:
  shows "conjugate (of_complex z) = of_complex (cnj z)"
  by (transfer, transfer, simp add: vec_cnj_def)

lemma conjugate_inf [simp]:
  shows "conjugate h = h"
  by (transfer, transfer, simp add: vec_cnj_def)

lemma conjugate_zero [simp]:
  shows "conjugate 0h = 0h"
  by (transfer, transfer, simp add: vec_cnj_def)

lemma conjugate_one [simp]:
  shows "conjugate 1h = 1h"
  by (transfer, transfer, simp add: vec_cnj_def)

lemma conjugate_inj:
  assumes "conjugate x = conjugate y"
  shows "x = y"
  using assms
  using conjugate_involution[of x] conjugate_involution[of y]
  by metis

lemma bij_conjugate [simp]:
  shows "bij conjugate"
  unfolding bij_def inj_on_def
proof auto
  fix x y
  assume "conjugate x = conjugate y"
  thus "x = y"
   by (simp add: conjugate_inj)
next
  fix x
  show "x  range conjugate"
    by (metis conjugate_involution range_eqI)
qed

lemma conjugate_id_iff: 
  shows "conjugate a = a  is_real (to_complex a)  a = h"
  using inf_or_of_complex[of a]
  by (metis conjugate_inf conjugate_of_complex eq_cnj_iff_real to_complex_of_complex)

subsubsection ‹Inversion›

text ‹Geometric inversion wrt. the unit circle›

definition inversion where
  "inversion = conjugate  reciprocal"

lemma inversion_sym:
  shows "inversion = reciprocal  conjugate"
  unfolding inversion_def
  apply (rule ext, simp)
  apply transfer
  apply transfer
  apply (auto simp add: vec_cnj_def)
  using one_neq_zero
  by blast+

lemma inversion_involution [simp]:
  shows "inversion (inversion z) = z"
proof-
  have *: "conjugate  reciprocal = reciprocal  conjugate"
    using inversion_sym
    by (simp add: inversion_def)
  show ?thesis
    unfolding inversion_def
    by (subst *) simp
qed

lemma inversion_inversion_id [simp]:
  shows "inversion  inversion = id"
  by (rule ext, simp)

lemma inversion_zero [simp]:
  shows "inversion 0h = h"
  by (simp add: inversion_def)

lemma inversion_infty [simp]:
  shows "inversion h = 0h"
  by (simp add: inversion_def)

lemma inversion_of_complex [simp]:
  assumes "z  0"
  shows "inversion (of_complex z) = of_complex (1 / cnj z)"
  using assms
  by (simp add: inversion_def)

lemma is_real_inversion:
  assumes "is_real x" and "x  0"
  shows "is_real (to_complex (inversion (of_complex x)))"
  using assms eq_cnj_iff_real[of x]
  by simp

lemma inversion_id_iff: 
  shows "a = inversion a  a  h  (to_complex a) * cnj (to_complex a) = 1" (is "?lhs = ?rhs")
proof
  assume "a = inversion a"
  thus ?rhs
    unfolding inversion_def
    using inf_or_of_complex[of a]
    by (metis (full_types) comp_apply complex_cnj_cancel_iff complex_cnj_zero inversion_def inversion_infty inversion_of_complex inversion_sym nonzero_eq_divide_eq of_complex_zero reciprocal_zero to_complex_of_complex zero_one_infty_not_equal(5))
next
  assume ?rhs
  thus ?lhs
    using inf_or_of_complex[of a]
    by (metis inversion_of_complex mult_not_zero nonzero_mult_div_cancel_right one_neq_zero to_complex_of_complex)
qed

(* ---------------------------------------------------------------------------- *)
subsection ‹Ratio and cross-ratio›
(* ---------------------------------------------------------------------------- *)

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Ratio›
(* ---------------------------------------------------------------------------- *)

text ‹Ratio of points $z$, $v$ and $w$ is usually defined as
$\frac{z-v}{z-w}$. Our definition introduces it in homogeneous
coordinates. It is well-defined if $z_1 \neq z_2 \vee z_1 \neq z_3$ and $z_1 \neq \infty_h$ and 
$z_2 \neq \infty_h \vee z_3 \neq \infty_h$›

definition ratio :: "complex_homo  complex_homo  complex_homo  complex_homo" where
  "ratio za zb zc = (za -h zb) :h (za -h zc)"

text ‹This is ill-defined, but holds by our definition›
lemma
  assumes "zb  h" and "zc  h"
  shows "ratio h zb zc = 1h"
  using assms
  using inf_sub_left[OF assms(1)]
  using inf_sub_left[OF assms(2)]
  unfolding ratio_def
  by (simp add: inf_divide_inf)

lemma
  assumes "za  h" and "zc  h"
  shows "ratio za h zc = h"
  using assms
  unfolding ratio_def
  using inf_sub_right[OF assms(1)]
  using sub_noteq_inf[OF assms]
  using divide_inf_left
  by simp

lemma
  assumes "za  h" and "zb  h"
  shows "ratio za zb h = 0h"
  unfolding ratio_def
  using sub_noteq_inf[OF assms]
  using inf_sub_right[OF assms(1)]
  using divide_inf_right
  by simp

lemma
  assumes "z1  z2" and "z1  h"
  shows "ratio z1 z2 z1 = h"
  using assms
  unfolding ratio_def
  using divide_zero_right[of "z1 -h z2"]
  using sub_eq_zero_iff[of z1 z2]
  by simp

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Cross-ratio›
(* ---------------------------------------------------------------------------- *)

text ‹The cross-ratio is defined over 4 points $(z, u, v, w)$, usually as
$\frac{(z-u)(v-w)}{(z-w)(v-u)}$. We define it using homogeneous coordinates. Cross ratio is
ill-defined when $z = u \vee v = w$ and $z = w$ and $v = u$ i.e. when 3 points are equal. Since
function must be total, in that case we define it arbitrarily to 1.›

definition cross_ratio_cvec :: "complex_vec  complex_vec  complex_vec  complex_vec  complex_vec" where
  [simp]: "cross_ratio_cvec z u v w =
     (let (z', z'') = z;
          (u', u'') = u;
          (v', v'') = v;
          (w', w'') = w;
          n1 = z'*u'' - u'*z'';
          n2 = v'*w'' - w'*v'';
          d1 = z'*w'' - w'*z'';
          d2 = v'*u'' - u'*v''
       in
         if n1 * n2  0  d1 * d2  0 then
              (n1 * n2, d1 * d2)
         else
              (1, 1))"

lift_definition cross_ratio_hcoords :: "complex_homo_coords  complex_homo_coords  complex_homo_coords  complex_homo_coords  complex_homo_coords" is cross_ratio_cvec
  by (auto split: if_split_asm)

lift_definition cross_ratio :: "complex_homo  complex_homo  complex_homo  complex_homo  complex_homo" is cross_ratio_hcoords
proof transfer
  fix z u v w z' u' v' w' :: complex_vec
  obtain z1 z2 u1 u2 v1 v2 w1 w2 z'1 z'2 u'1 u'2 v'1 v'2 w'1 w'2
    where *: "z = (z1, z2)" "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)"
             "z' = (z'1, z'2)" "u' = (u'1, u'2)" "v' = (v'1, v'2)" "w' = (w'1, w'2)"
    by (cases z, auto, cases u, auto, cases v, auto, cases w, auto,
        cases z', auto, cases u', auto, cases v', auto, cases w', auto)
  let ?n1 = "z1*u2 - u1*z2"
  let ?n2 = "v1*w2 - w1*v2"
  let ?d1 = "z1*w2 - w1*z2"
  let ?d2 = "v1*u2 - u1*v2"
  let ?n1' = "z'1*u'2 - u'1*z'2"
  let ?n2' = "v'1*w'2 - w'1*v'2"
  let ?d1' = "z'1*w'2 - w'1*z'2"
  let ?d2' = "v'1*u'2 - u'1*v'2"

  assume **:
         "z  vec_zero" "u  vec_zero" "v  vec_zero" "w  vec_zero"
         "z'  vec_zero" "u'  vec_zero" "v'  vec_zero" "w'  vec_zero"
         "z v z'" "v v v'" "u v u'" "w v w'"
  show "cross_ratio_cvec z u v w v cross_ratio_cvec z' u' v' w'"
  proof (cases "?n1*?n2  0  ?d1*?d2  0")
    case True
    hence "?n1'*?n2'  0  ?d1'*?d2'  0"
      using * **
      by simp ((erule exE)+, simp)
    show ?thesis
      using ?n1*?n2  0  ?d1*?d2  0
      using ?n1'*?n2'  0  ?d1'*?d2'  0
      using * **
      by simp ((erule exE)+, rule_tac x="k*ka*kb*kc" in exI, simp add: field_simps)
  next
    case False
    hence "¬ (?n1'*?n2'  0  ?d1'*?d2'  0)"
      using * **
      by simp ((erule exE)+, simp)
    show ?thesis
      using ¬ (?n1*?n2  0  ?d1*?d2  0)
      using ¬ (?n1'*?n2'  0  ?d1'*?d2'  0)
      using * **
      by simp blast
  qed
qed

lemma cross_ratio_01inf_id [simp]:
  shows "cross_ratio z 0h 1h h = z"
proof (transfer, transfer)
  fix z :: complex_vec
  obtain z1 z2 where *: "z = (z1, z2)"
    by (cases z, auto)
  assume "z  vec_zero"
  thus "cross_ratio_cvec z 0v 1v v v z"
    using *
    by simp (rule_tac x="-1" in exI, simp)
qed

lemma cross_ratio_0:
  assumes "u  v" and "u  w"
  shows "cross_ratio u u v w = 0h"
  using assms
proof (transfer, transfer)
  fix u v w  :: complex_vec
  obtain u1 u2 v1 v2 w1 w2
    where *: "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)"
    by (cases u, auto, cases v, auto, cases w, auto)
  assume "u  vec_zero" "v  vec_zero" "w  vec_zero" "¬ u v v" "¬ u v w"
  thus "cross_ratio_cvec u u v w v 0v"
    using * complex_cvec_eq_mix[of u1 u2 v1 v2] complex_cvec_eq_mix[of u1 u2 w1 w2]
    by (force simp add: mult.commute)
qed

lemma cross_ratio_1:
  assumes "u  v" and "v  w"
  shows "cross_ratio v u v w = 1h"
  using assms
proof (transfer, transfer)
  fix u v w  :: complex_vec
  obtain u1 u2 v1 v2 w1 w2
    where *: "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)"
    by (cases u, auto, cases v, auto, cases w, auto)
  let ?n1 = "v1*u2 - u1*v2"
  let ?n2 = "v1*w2 - w1*v2"
  assume "u  vec_zero" "v  vec_zero" "w  vec_zero" "¬ u v v" "¬ v v w"
  hence "?n1  0  ?n2  0"
    using * complex_cvec_eq_mix[of u1 u2 v1 v2] complex_cvec_eq_mix[of v1 v2 w1 w2]
    by (auto simp add: field_simps)
  thus "cross_ratio_cvec v u v w v 1v"
    using *
    by simp (rule_tac x="1 / (?n1 * ?n2)" in exI, simp)
qed

lemma cross_ratio_inf:
  assumes "u  w" and "v  w"
  shows "cross_ratio w u v w = h"
  using assms
proof (transfer, transfer)
  fix u v w  :: complex_vec
  obtain u1 u2 v1 v2 w1 w2
    where *: "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)"
    by (cases u, auto, cases v, auto, cases w, auto)
  let ?n1 = "w1*u2 - u1*w2"
  let ?n2 = "v1*w2 - w1*v2"
  assume "u  vec_zero" "v  vec_zero" "w  vec_zero" "¬ u v w" "¬ v v w"
  hence "?n1  0  ?n2  0"
    using * complex_cvec_eq_mix[of u1 u2 w1 w2] complex_cvec_eq_mix[of v1 v2 w1 w2]
    by (auto simp add: field_simps)
  thus "cross_ratio_cvec w u v w v v"
    using *
    by simp
qed

lemma cross_ratio_0inf:
  assumes "y  0"
  shows "cross_ratio (of_complex x) 0h (of_complex y) h = (of_complex (x / y))"
  using assms
  by (transfer, transfer) (simp, rule_tac x="-1/y" in exI, simp)

lemma cross_ratio_commute_13:
  shows "cross_ratio z u v w = reciprocal (cross_ratio v u z w)"
  by (transfer, transfer, case_tac z, case_tac u, case_tac v, case_tac w, simp)

lemma cross_ratio_commute_24:
  shows "cross_ratio z u v w = reciprocal (cross_ratio z w v u)"
  by (transfer, transfer, case_tac z, case_tac u, case_tac v, case_tac w, simp)

lemma cross_ratio_not_inf:
  assumes "z  w" and "u  v"
  shows "cross_ratio z u v w  h"
  using assms
proof (transfer, transfer)
  fix z u v w
  assume nz: "z  vec_zero" "u  vec_zero" "v  vec_zero" "w  vec_zero"
  obtain z1 z2 u1 u2 v1 v2 w1 w2 where *: "z = (z1, z2)" "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)"
    by (cases z, cases u, cases v, cases w, auto)
  obtain x1 x2 where **: "cross_ratio_cvec z u v w = (x1, x2)"
    by (cases "cross_ratio_cvec z u v w", auto)
  assume "¬ z v w" "¬ u v v"
  hence "z1*w2  z2*w1" "u1*v2  u2*v1"
    using * nz complex_cvec_eq_mix
    by blast+
  hence "x2  0"
    using * **
    by (auto split: if_split_asm) (simp add: field_simps)
  thus "¬ cross_ratio_cvec z u v w v v"
    using inf_cvec_z2_zero_iff * **
    by simp
qed

lemma cross_ratio_not_zero:
  assumes "z  u" and "v  w"
  shows "cross_ratio z u v w  0h"
  using assms
proof (transfer, transfer)
  fix z u v w
  assume nz: "z  vec_zero" "u  vec_zero" "v  vec_zero" "w  vec_zero"
  obtain z1 z2 u1 u2 v1 v2 w1 w2 where *: "z = (z1, z2)" "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)"
    by (cases z, cases u, cases v, cases w, auto)
  obtain x1 x2 where **: "cross_ratio_cvec z u v w = (x1, x2)"
    by (cases "cross_ratio_cvec z u v w", auto)
  assume "¬ z v u" "¬ v v w"
  hence "z1*u2  z2*u1" "v1*w2  v2*w1"
    using * nz complex_cvec_eq_mix
    by blast+
  hence "x1  0"
    using * **
    by (auto split: if_split_asm)
  thus "¬ cross_ratio_cvec z u v w v 0v"
    using zero_cvec_z1_zero_iff * **
    by simp
qed

lemma cross_ratio_real:
  assumes "is_real z" and "is_real u" and "is_real v" and "is_real w" 
  assumes "z  u  v  w  z  w  u  v"
  shows "is_real (to_complex (cross_ratio (of_complex z) (of_complex u) (of_complex v) (of_complex w)))"
  using assms
  by (transfer, transfer, auto)

lemma cross_ratio:
  assumes "(z  u  v  w)  (z  w  u  v)" and
          "z  h" and  "u  h" and "v  h" and "w  h"
  shows "cross_ratio z u v w = ((z -h u) *h (v -h w)) :h ((z -h w) *h (v -h u))"
  unfolding sub_def divide_def
  using assms
  apply transfer
  apply simp
  apply transfer
proof-
  fix z u v w :: complex_vec
  obtain z1 z2 u1 u2 v1 v2 w1 w2
    where *: "z = (z1, z2)" "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)"
    by (cases z, auto, cases u, auto, cases v, auto, cases w, auto)

  let ?n1 = "z1*u2 - u1*z2"
  let ?n2 = "v1*w2 - w1*v2"
  let ?d1 = "z1*w2 - w1*z2"
  let ?d2 = "v1*u2 - u1*v2"
  assume **: "z  vec_zero" "u  vec_zero" "v  vec_zero" "w  vec_zero"
         "¬ z v u  ¬ v v w  ¬ z v w  ¬ u v v"
         "¬ z v v" "¬ u v v" "¬ v v v" "¬ w v v"

  hence ***: "?n1 * ?n2  0  ?d1 * ?d2  0"
    using *
    using complex_cvec_eq_mix[of z1 z2 u1 u2] complex_cvec_eq_mix[of v1 v2 w1 w2]
    using complex_cvec_eq_mix[of z1 z2 w1 w2] complex_cvec_eq_mix[of u1 u2 v1 v2]
    by (metis eq_iff_diff_eq_0 mult.commute mult_eq_0_iff)

  have ****: "z2  0" "w2  0" "u2  0" "v2  0"
    using * **(1-4) **(6-9)
    using inf_cvec_z2_zero_iff[of z1 z2]
    using inf_cvec_z2_zero_iff[of u1 u2]
    using inf_cvec_z2_zero_iff[of v1 v2]
    using inf_cvec_z2_zero_iff[of w1 w2]
    by blast+

  have "cross_ratio_cvec z u v w = (?n1*?n2, ?d1*?d2)"
    using * ***
    by simp
  moreover
  let ?k = "z2*u2*v2*w2"
  have "(z +v ~v u) *v (v +v ~v w) *v reciprocal_cvec ((z +v ~v w) *v (v +v ~v u)) = (?k * ?n1 * ?n2, ?k * ?d1 * ?d2)"
    using * *** ****
    by auto
  ultimately
  show "cross_ratio_cvec z u v w v
           (z +v ~v u) *v (v +v ~v w) *v reciprocal_cvec ((z +v ~v w) *v (v +v ~v u))"
    using ****
    unfolding complex_cvec_eq_def
    by (rule_tac x="?k" in exI) simp
qed

end

(*
(* Although it seems useful, we did not use this. *)

text ‹Transfer extended complex plane to complex plane›

definition HC :: "complex_homo ⇒ complex ⇒ bool"
  where "HC = (λ h c. h = of_complex c)"

lemma Domainp_HC [transfer_domain_rule]: "Domainp HC = (λ x. x ≠ ∞h)"
  unfolding HC_def Domainp_iff[abs_def]
  apply (rule ext)
  using inf_or_of_complex
  by auto

lemma bi_unique_HC [transfer_rule]: "bi_unique HC"
  using of_complex_inj
  unfolding HC_def bi_unique_def
  by auto

lemma right_total_HC [transfer_rule]: "right_total HC"
  unfolding HC_def right_total_def
  by auto

lemma HC_0 [transfer_rule]: "HC 0h 0"
  unfolding HC_def
  by simp

lemma HC_1 [transfer_rule]: "HC 1h 1"
  unfolding HC_def
  by simp

context includes lifting_syntax
begin
lemma HC_add [transfer_rule]: "(HC ===> HC ===> HC) (op +h) (op +)"
  unfolding rel_fun_def HC_def
  by auto

lemma HC_mult [transfer_rule]: "(HC ===> HC ===> HC) (op *h) ( op * )"
  unfolding rel_fun_def HC_def
  by auto

lemma HC_All [transfer_rule]:
  "((HC ===> op =) ===> op =) (Ball {z. z ≠ ∞h}) All"
  using inf_or_of_complex
  unfolding rel_fun_def HC_def
  by auto

lemma HC_transfer_forall [transfer_rule]:
  "((HC ===> op =) ===> op =) (transfer_bforall (λx. x ≠ ∞h)) transfer_forall"
  using inf_or_of_complex
  unfolding transfer_forall_def transfer_bforall_def
  unfolding rel_fun_def HC_def
  by auto
end
*)

Theory Moebius

(* -------------------------------------------------------------------------- *)
section ‹Möbius transformations›
(* -------------------------------------------------------------------------- *)

text ‹Möbius transformations (also called homographic, linear fractional, or bilinear
transformations) are the fundamental transformations of the extended complex plane. Here they are
introduced algebraically. Each transformation is represented by a regular (non-singular,
non-degenerate) $2\times 2$ matrix that acts linearly on homogeneous coordinates. As proportional
homogeneous coordinates represent same points of $\mathbb{\overline{C}}$, proportional matrices will
represent the same Möbius transformation.›

theory Moebius
imports Homogeneous_Coordinates
begin

(* -------------------------------------------------------------------------- *)
subsection ‹Definition of Möbius transformations›
(* -------------------------------------------------------------------------- *)

typedef moebius_mat = "{M::complex_mat. mat_det M  0}"
  by (rule_tac x="eye" in exI, simp)

setup_lifting type_definition_moebius_mat

definition moebius_cmat_eq :: "complex_mat  complex_mat  bool" where                     
  [simp]: "moebius_cmat_eq A B   ( k::complex. k  0  B = k *sm A)"

lift_definition moebius_mat_eq :: "moebius_mat  moebius_mat  bool" is moebius_cmat_eq
  done

lemma moebius_mat_eq_refl [simp]: 
  shows "moebius_mat_eq x x"
  by transfer simp

quotient_type moebius = moebius_mat / moebius_mat_eq
proof (rule equivpI)
  show "reflp moebius_mat_eq"
    unfolding reflp_def
    by transfer auto
next
  show "symp moebius_mat_eq"
    unfolding symp_def
    by transfer (auto simp add: symp_def, rule_tac x="1/k" in exI, simp)
next
  show "transp moebius_mat_eq"
    unfolding transp_def
    by transfer (auto simp add: transp_def, rule_tac x="ka*k" in exI, simp)
qed

definition mk_moebius_cmat :: "complex  complex  complex  complex  complex_mat" where
 [simp]: "mk_moebius_cmat a b c d =
           (let M = (a, b, c, d)
             in if mat_det M  0 then
                M
             else
                eye)"

lift_definition mk_moebius_mat :: "complex  complex  complex  complex  moebius_mat" is mk_moebius_cmat
  by simp

lift_definition mk_moebius :: "complex  complex  complex  complex  moebius" is mk_moebius_mat
  done

lemma ex_mk_moebius:
  shows " a b c d. M = mk_moebius a b c d  mat_det (a, b, c, d)  0"
proof (transfer, transfer)
  fix M :: complex_mat
  assume "mat_det M  0"
  obtain a b c d where "M = (a, b, c, d)"
    by (cases M, auto)
  hence "moebius_cmat_eq M (mk_moebius_cmat a b c d)  mat_det (a, b, c, d)  0"
    using ‹mat_det M  0
    by auto (rule_tac x=1 in exI, simp)
  thus "a b c d. moebius_cmat_eq M (mk_moebius_cmat a b c d)  mat_det (a, b, c, d)  0"
    by blast
qed

(* -------------------------------------------------------------------------- *)
subsection ‹Action on points›
(* -------------------------------------------------------------------------- *)

text ‹Möbius transformations are given as the action of Möbius group on the points of the
extended complex plane (in homogeneous coordinates).›

definition moebius_pt_cmat_cvec :: "complex_mat  complex_vec  complex_vec" where
   [simp]: "moebius_pt_cmat_cvec M z = M *mv z"

lift_definition moebius_pt_mmat_hcoords :: "moebius_mat  complex_homo_coords  complex_homo_coords" is moebius_pt_cmat_cvec
  by auto algebra+

lift_definition moebius_pt :: "moebius  complex_homo  complex_homo" is moebius_pt_mmat_hcoords
proof transfer
  fix M M' x x'
  assume "moebius_cmat_eq M M'" "x v x'"
  thus "moebius_pt_cmat_cvec M x v moebius_pt_cmat_cvec M' x'"
    by (cases "M", cases "x", auto simp add: field_simps) (rule_tac x="k*ka" in exI, simp)
qed

lemma bij_moebius_pt [simp]:
  shows "bij (moebius_pt M)"
  unfolding bij_def inj_on_def surj_def
proof safe
  fix x y
  assume "moebius_pt M x = moebius_pt M y"
  thus "x = y"
  proof (transfer, transfer)
    fix M x y
    assume "mat_det M  0" "moebius_pt_cmat_cvec M x v moebius_pt_cmat_cvec M y"
    thus "x v y"
      using mult_sv_mv[of _ M x] mult_mv_inv[of _ M]
      unfolding moebius_pt_cmat_cvec_def
      by (metis complex_cvec_eq_def)
  qed
next
  fix y
  show "x. y = moebius_pt M x"
  proof (transfer, transfer)
    fix y :: complex_vec and M :: complex_mat
    assume *: "y  vec_zero" "mat_det M  0"
    let ?iM = "mat_inv M"
    let ?x = "?iM *mv y"
    have "?x  vec_zero"
      using *
      by (metis mat_det_mult mat_eye_r mat_inv_r mult_cancel_right1 mult_mv_nonzero)
    moreover
    have "y v moebius_pt_cmat_cvec M ?x"
      by (simp del: eye_def add: mat_inv_r[OF ‹mat_det M  0])
    ultimately
    show "x{v. v  vec_zero}. y v moebius_pt_cmat_cvec M x"
      by (rule_tac x="?x" in bexI, simp_all)
  qed
qed

lemma moebius_pt_eq_I:                                          
  assumes "moebius_pt M z1 = moebius_pt M z2"
  shows "z1 = z2"
  using assms
  using bij_moebius_pt[of M]
  unfolding bij_def inj_on_def
  by blast

lemma moebius_pt_neq_I [simp]:
  assumes "z1  z2"
  shows "moebius_pt M z1  moebius_pt M z2"
  using assms
  by (auto simp add: moebius_pt_eq_I)

definition is_moebius :: "(complex_homo  complex_homo)  bool" where
  "is_moebius f  ( M. f = moebius_pt M)"

text ‹In the classic literature Möbius transformations are often expressed in the form
$\frac{az+b}{cz+d}$. The following lemma shows that when restricted to finite points, the action
of Möbius transformations is bilinear.›

lemma moebius_pt_bilinear:
  assumes "mat_det (a, b, c, d)  0"
  shows "moebius_pt (mk_moebius a b c d) z =
            (if z  h then
                 ((of_complex a) *h z +h (of_complex b)) :h
                 ((of_complex c) *h z +h (of_complex d))
             else
                 (of_complex a) :h
                 (of_complex c))"
  unfolding divide_def
  using assms
proof (transfer, transfer)
  fix a b c d :: complex and z :: complex_vec
  obtain z1 z2 where zz: "z = (z1, z2)"
    by (cases z, auto)
  assume *: "mat_det (a, b, c, d)  0" "z  vec_zero"
  let ?oc = "of_complex_cvec"
  show "moebius_pt_cmat_cvec (mk_moebius_cmat a b c d) z v
       (if ¬ z v v
        then (?oc a *v z +v ?oc b) *v
             reciprocal_cvec (?oc c *v z +v ?oc d)
        else ?oc a *v
             reciprocal_cvec (?oc c))"
  proof (cases "z v v")
    case True
    thus ?thesis
      using zz *
      by auto
  next
    case False
    hence "z2  0"
      using zz inf_cvec_z2_zero_iff z  vec_zero›
      by auto
    thus ?thesis
      using zz * False
      using regular_homogenous_system[of a b c d z1 z2]
      by auto
  qed
qed

(* -------------------------------------------------------------------------- *)
subsection ‹Möbius group›
(* -------------------------------------------------------------------------- *)

text ‹Möbius elements form a group under composition. This group is called the \emph{projective
general linear group} and denoted by $PGL(2, \mathbb{C})$ (the group $SGL(2, \mathbb{C})$ containing elements
with the determinant $1$ can also be considered).›

text ‹Identity Möbius transformation is represented by the identity matrix.›

definition id_moebius_cmat :: "complex_mat" where
  [simp]: "id_moebius_cmat = eye"

lift_definition id_moebius_mmat :: "moebius_mat" is id_moebius_cmat
  by simp

lift_definition id_moebius :: "moebius" is id_moebius_mmat
  done

lemma moebius_pt_moebius_id [simp]:
  shows "moebius_pt id_moebius = id"
  unfolding id_def
  apply (rule ext, transfer, transfer)
  using eye_mv_l
  by simp

lemma mk_moeibus_id [simp]:
  shows "mk_moebius a 0 0 a = id_moebius"
  by (transfer, transfer, simp)

text ‹The inverse Möbius transformation is obtained by taking the inverse representative matrix.›

definition moebius_inv_cmat :: "complex_mat  complex_mat" where
  [simp]: "moebius_inv_cmat M = mat_inv M"

lift_definition moebius_inv_mmat :: "moebius_mat  moebius_mat" is moebius_inv_cmat
  by (simp add: mat_det_inv)

lift_definition moebius_inv :: "moebius  moebius" is "moebius_inv_mmat"
proof (transfer)
  fix x y
  assume "moebius_cmat_eq x y"
  thus "moebius_cmat_eq (moebius_inv_cmat x) (moebius_inv_cmat y)"
    by (auto simp add: mat_inv_mult_sm) (rule_tac x="1/k" in exI, simp)
qed

lemma moebius_inv:
  shows "moebius_pt (moebius_inv M) = inv (moebius_pt M)"
proof (rule inv_equality[symmetric])
  fix x
  show "moebius_pt (moebius_inv M) (moebius_pt M x) = x"
  proof (transfer, transfer)
    fix M::complex_mat and x::complex_vec
    assume "mat_det M  0" "x  vec_zero"
    show "moebius_pt_cmat_cvec (moebius_inv_cmat M) (moebius_pt_cmat_cvec M x) v x"
      using eye_mv_l
      by (simp add: mat_inv_l[OF ‹mat_det M  0])
  qed
next
  fix y
  show "moebius_pt M (moebius_pt (moebius_inv M) y) = y"
  proof (transfer, transfer)
    fix M::complex_mat and y::complex_vec
    assume "mat_det M  0" "y  vec_zero"
    show "moebius_pt_cmat_cvec M (moebius_pt_cmat_cvec (moebius_inv_cmat M) y) v y"
      using eye_mv_l
      by (simp add: mat_inv_r[OF ‹mat_det M  0])
  qed
qed

lemma is_moebius_inv [simp]:
  assumes "is_moebius m"
  shows "is_moebius (inv m)"
  using assms
  using moebius_inv
  unfolding is_moebius_def
  by metis

lemma moebius_inv_mk_moebus [simp]:
  assumes "mat_det (a, b, c, d)  0"
  shows "moebius_inv (mk_moebius a b c d) =
         mk_moebius (d/(a*d-b*c)) (-b/(a*d-b*c)) (-c/(a*d-b*c)) (a/(a*d-b*c))"
  using assms
  by (transfer, transfer) (auto, rule_tac x=1 in exI, simp_all add: field_simps)

text ‹Composition of Möbius elements is obtained by multiplying their representing matrices.›

definition moebius_comp_cmat :: "complex_mat  complex_mat  complex_mat" where
  [simp]: "moebius_comp_cmat M1 M2 = M1 *mm M2"

lift_definition moebius_comp_mmat :: "moebius_mat  moebius_mat  moebius_mat" is moebius_comp_cmat
  by simp

lift_definition moebius_comp :: "moebius  moebius  moebius" is moebius_comp_mmat
  by transfer (simp, (erule exE)+, rule_tac x="k*ka" in exI, simp add: field_simps)

lemma moebius_comp: 
  shows "moebius_pt (moebius_comp M1 M2) = moebius_pt M1  moebius_pt M2"
  unfolding comp_def
  by (rule ext, transfer, transfer, simp)

lemma moebius_pt_comp [simp]:
  shows "moebius_pt (moebius_comp M1 M2) z = moebius_pt M1 (moebius_pt M2 z)"
  by (auto simp add: moebius_comp)

lemma is_moebius_comp [simp]:
  assumes "is_moebius m1" and "is_moebius m2"
  shows "is_moebius (m1  m2)"
  using assms
  unfolding is_moebius_def
  using moebius_comp
  by metis

lemma moebius_comp_mk_moebius [simp]:
  assumes "mat_det (a, b, c, d)  0" and "mat_det (a', b', c', d')  0"
  shows "moebius_comp (mk_moebius a b c d) (mk_moebius a' b' c' d') =
           mk_moebius (a * a' + b * c') (a * b' + b * d') (c * a' + d * c') (c * b' + d * d')"
  using mat_det_mult[of "(a, b, c, d)" "(a', b', c', d')"]
  using assms
  by (transfer, transfer) (auto, rule_tac x=1 in exI, simp)

instantiation moebius :: group_add
begin
definition plus_moebius :: "moebius  moebius  moebius" where
  [simp]: "plus_moebius = moebius_comp"

definition uminus_moebius :: "moebius  moebius" where
  [simp]: "uminus_moebius = moebius_inv"

definition zero_moebius :: "moebius" where
  [simp]: "zero_moebius = id_moebius"

definition minus_moebius :: "moebius  moebius  moebius" where
  [simp]: "minus_moebius A B = A + (-B)"

instance proof
  fix a b c :: moebius
  show "a + b + c = a + (b + c)"
    unfolding plus_moebius_def
  proof (transfer, transfer)
    fix a b c :: complex_mat
    assume "mat_det a  0" "mat_det b  0" "mat_det c  0"
    show "moebius_cmat_eq (moebius_comp_cmat (moebius_comp_cmat a b) c) (moebius_comp_cmat a (moebius_comp_cmat b c))"
      by simp (rule_tac x="1" in exI, simp add: mult_mm_assoc)
  qed
next
  fix a :: moebius
  show "a + 0 = a"
    unfolding plus_moebius_def zero_moebius_def
  proof (transfer, transfer)
    fix A :: complex_mat
    assume "mat_det A  0"
    thus "moebius_cmat_eq (moebius_comp_cmat A id_moebius_cmat) A"
      using mat_eye_r
      by simp
  qed
next
  fix a :: moebius
  show "0 + a = a"
    unfolding plus_moebius_def zero_moebius_def
  proof (transfer, transfer)
    fix A :: complex_mat
    assume "mat_det A  0"
    thus "moebius_cmat_eq (moebius_comp_cmat id_moebius_cmat A) A"
      using mat_eye_l
      by simp
  qed
next
  fix a :: moebius
  show "- a + a = 0"
    unfolding plus_moebius_def uminus_moebius_def zero_moebius_def
  proof (transfer, transfer)
    fix a :: complex_mat
    assume "mat_det a  0"
    thus "moebius_cmat_eq (moebius_comp_cmat (moebius_inv_cmat a) a) id_moebius_cmat"
      by (simp add: mat_inv_l)
  qed
next
  fix a b :: moebius
  show "a + - b = a - b"
    unfolding minus_moebius_def
    by simp
qed
end

text ‹Composition with inverse›

lemma moebius_comp_inv_left [simp]: 
  shows "moebius_comp (moebius_inv M) M = id_moebius"
  by (metis left_minus plus_moebius_def uminus_moebius_def zero_moebius_def)

lemma moebius_comp_inv_right [simp]:
  shows "moebius_comp M (moebius_inv M) = id_moebius"
  by (metis right_minus plus_moebius_def uminus_moebius_def zero_moebius_def)

lemma moebius_pt_comp_inv_left [simp]:
  shows "moebius_pt (moebius_inv M) (moebius_pt M z) = z"
  by (subst moebius_pt_comp[symmetric], simp)

lemma moebius_pt_comp_inv_right [simp]: 
  shows "moebius_pt M (moebius_pt (moebius_inv M) z) = z"
  by (subst moebius_pt_comp[symmetric], simp)

lemma moebius_pt_comp_inv_image_left [simp]:
  shows "moebius_pt (moebius_inv M) ` moebius_pt M ` A = A"
  by force

lemma moebius_pt_comp_inv_image_right [simp]:
  shows "moebius_pt M ` moebius_pt (moebius_inv M) ` A = A"
  by force

lemma moebius_pt_invert:
  assumes "moebius_pt M z1 = z2"
  shows "moebius_pt (moebius_inv M) z2 = z1"
  using assms[symmetric]
  by simp

lemma moebius_pt_moebius_inv_in_set [simp]:
  assumes "moebius_pt M z  A"
  shows "z  moebius_pt (moebius_inv M) ` A"
  using assms
  using image_iff
  by fastforce

(* -------------------------------------------------------------------------- *)
subsection ‹Special kinds of Möbius transformations›
(* -------------------------------------------------------------------------- *)

(* -------------------------------------------------------------------------- *)
subsubsection ‹Reciprocal (1/z) as a Möbius transformation›
(* -------------------------------------------------------------------------- *)

definition moebius_reciprocal :: "moebius" where
  "moebius_reciprocal = mk_moebius 0 1 1 0"

lemma moebius_reciprocal [simp]:
  shows "moebius_pt moebius_reciprocal = reciprocal"
  unfolding moebius_reciprocal_def
  by (rule ext, transfer, transfer) (force simp add: split_def)

lemma moebius_reciprocal_inv [simp]:
  shows "moebius_inv moebius_reciprocal = moebius_reciprocal"
  unfolding moebius_reciprocal_def
  by (transfer, transfer) simp

(* -------------------------------------------------------------------------- *)
subsubsection ‹Euclidean similarities as a Möbius transform›
(* -------------------------------------------------------------------------- *)

text‹Euclidean similarities include Euclidean isometries (translations and rotations) and 
dilatations.›

definition moebius_similarity :: "complex  complex  moebius" where
  "moebius_similarity a b = mk_moebius a b 0 1"

lemma moebius_pt_moebius_similarity [simp]:
  assumes "a  0"
  shows "moebius_pt (moebius_similarity a b) z = (of_complex a) *h z +h (of_complex b)"
  unfolding moebius_similarity_def
  using assms
  using mult_inf_right[of "of_complex a"]
  by (subst moebius_pt_bilinear, auto)

text ‹Their action is a linear transformation of $\mathbb{C}.$›
lemma moebius_pt_moebius_similarity':
  assumes "a  0"
  shows "moebius_pt (moebius_similarity a b) = (λ z. (of_complex a) *h z +h (of_complex b))"
  using moebius_pt_moebius_similarity[OF assms, symmetric]
  by simp

lemma is_moebius_similarity':
  assumes "a  0h" and "a  h" and "b  h"
  shows "(λ z. a *h z +h b) = moebius_pt (moebius_similarity (to_complex a) (to_complex b))"
proof-
  obtain ka kb where *: "a = of_complex ka"  "ka  0" "b = of_complex kb"
    using assms
    using inf_or_of_complex[of a]  inf_or_of_complex[of b]
    by auto
  thus ?thesis
    unfolding is_moebius_def
    using moebius_pt_moebius_similarity'[of ka kb]
    by simp
qed

lemma is_moebius_similarity:
  assumes "a  0h" and "a  h" and "b  h"
  shows "is_moebius (λ z. a *h z +h b)"
  using is_moebius_similarity'[OF assms]
  unfolding is_moebius_def
  by auto

text ‹Euclidean similarities form a group.›

lemma moebius_similarity_id [simp]:
  shows "moebius_similarity 1 0 = id_moebius"
  unfolding moebius_similarity_def
  by simp

lemma moebius_similarity_inv [simp]:
  assumes "a  0"
  shows "moebius_inv (moebius_similarity a b) = moebius_similarity (1/a) (-b/a)"
  using assms
  unfolding moebius_similarity_def
  by simp

lemma moebius_similarity_uminus [simp]:
  assumes "a  0"
  shows "- moebius_similarity a b = moebius_similarity (1/a) (-b/a)"
  using assms
  by simp

lemma moebius_similarity_comp [simp]:
  assumes "a  0" and "c  0"
  shows "moebius_comp (moebius_similarity a b) (moebius_similarity c d) = moebius_similarity (a*c) (a*d+b)"
  using assms
  unfolding moebius_similarity_def
  by simp

lemma moebius_similarity_plus [simp]:
  assumes "a  0" and "c  0"
  shows "moebius_similarity a b + moebius_similarity c d = moebius_similarity (a*c) (a*d+b)"
  using assms
  by simp

text ‹Euclidean similarities are the only Möbius group elements such that their action leaves the
$\infty_{h}$ fixed.›
lemma moebius_similarity_inf [simp]:
  assumes "a  0"
  shows "moebius_pt (moebius_similarity a b) h = h"
  using assms
  unfolding moebius_similarity_def
  by (transfer, transfer, simp)

lemma moebius_similarity_only_inf_to_inf:
  assumes "a  0"  "moebius_pt (moebius_similarity a b) z = h"
  shows "z = h"
  using assms
  using inf_or_of_complex[of z]
  by auto

lemma moebius_similarity_inf_iff [simp]:
  assumes "a  0"
  shows "moebius_pt (moebius_similarity a b) z = h  z = h"
  using assms
  using moebius_similarity_only_inf_to_inf[of a b z]
  by auto

lemma inf_fixed_only_moebius_similarity:
  assumes "moebius_pt M h = h"
  shows " a b. a  0  M = moebius_similarity a b"
  using assms
  unfolding moebius_similarity_def
proof (transfer, transfer)
  fix M :: complex_mat
  obtain a b c d where MM: "M = (a, b, c, d)"
    by (cases M, auto)
  assume "mat_det M  0" "moebius_pt_cmat_cvec M v v v"
  hence *: "c = 0" "a  0  d  0"
    using MM
    by auto
  show "a b. a  0  moebius_cmat_eq M (mk_moebius_cmat a b 0 1)"
  proof (rule_tac x="a/d" in exI, rule_tac x="b/d" in exI)
    show "a/d  0  moebius_cmat_eq M (mk_moebius_cmat (a / d) (b / d) 0 1)"
      using MM *
      by simp (rule_tac x="1/d" in exI, simp)
  qed
qed

text ‹Euclidean similarities include translations, rotations, and dilatations.›

(* -------------------------------------------------------------------------- *)
subsubsection ‹Translation›
(* -------------------------------------------------------------------------- *)

definition moebius_translation where
  "moebius_translation v = moebius_similarity 1 v"

lemma moebius_translation_comp [simp]:
  shows "moebius_comp (moebius_translation v1) (moebius_translation v2) = moebius_translation (v1 + v2)"
  unfolding moebius_translation_def
  by (simp add: field_simps)

lemma moebius_translation_plus [simp]:
  shows "(moebius_translation v1) + (moebius_translation v2) = moebius_translation (v1 + v2)"
  by simp

lemma moebius_translation_zero [simp]:
  shows "moebius_translation 0 = id_moebius"
  unfolding moebius_translation_def moebius_similarity_id
  by simp

lemma moebius_translation_inv [simp]:
  shows "moebius_inv (moebius_translation v1) = moebius_translation (-v1)"
  using moebius_translation_comp[of v1 "-v1"] moebius_translation_zero
  using minus_unique[of "moebius_translation v1" "moebius_translation (-v1)"]
  by simp

lemma moebius_translation_uminus [simp]:
  shows "- (moebius_translation v1) = moebius_translation (-v1)"
  by simp

lemma moebius_translation_inv_translation [simp]:
  shows "moebius_pt (moebius_translation v) (moebius_pt (moebius_translation (-v)) z) = z"
  using moebius_translation_inv[symmetric, of v]
  by (simp del: moebius_translation_inv)

lemma moebius_inv_translation_translation [simp]:
  shows "moebius_pt (moebius_translation (-v)) (moebius_pt (moebius_translation v) z) = z"
  using moebius_translation_inv[symmetric, of v]
  by (simp del: moebius_translation_inv)

lemma moebius_pt_moebius_translation [simp]:
  shows "moebius_pt (moebius_translation v) (of_complex z) = of_complex (z + v)"
  unfolding moebius_translation_def
  by (simp add: field_simps)

lemma moebius_pt_moebius_translation_inf [simp]:
  shows "moebius_pt (moebius_translation v) h = h"
  unfolding moebius_translation_def
  by simp

(* -------------------------------------------------------------------------- *)
subsubsection ‹Rotation›
(* -------------------------------------------------------------------------- *)

definition moebius_rotation where
  "moebius_rotation φ = moebius_similarity (cis φ) 0"

lemma moebius_rotation_comp [simp]:
  shows "moebius_comp (moebius_rotation φ1) (moebius_rotation φ2) = moebius_rotation (φ1 + φ2)"
  unfolding moebius_rotation_def
  using moebius_similarity_comp[of "cis φ1" "cis φ2" 0 0]
  by (simp add: cis_mult)

lemma moebius_rotation_plus [simp]:
  shows "(moebius_rotation φ1) + (moebius_rotation φ2) = moebius_rotation (φ1 + φ2)"
  by simp

lemma moebius_rotation_zero [simp]:
  shows "moebius_rotation 0 = id_moebius"
  unfolding moebius_rotation_def
  using moebius_similarity_id
  by simp

lemma moebius_rotation_inv [simp]:
  shows "moebius_inv (moebius_rotation φ) = moebius_rotation (- φ)"
  using moebius_rotation_comp[of φ "-φ"] moebius_rotation_zero
  using minus_unique[of "moebius_rotation φ" "moebius_rotation (-φ)"]
  by simp

lemma moebius_rotation_uminus [simp]:
  shows "- (moebius_rotation φ) = moebius_rotation (- φ)"
  by simp
                                                                                          
lemma moebius_rotation_inv_rotation [simp]:
  shows "moebius_pt (moebius_rotation φ) (moebius_pt (moebius_rotation (-φ)) z) = z"
  using moebius_rotation_inv[symmetric, of φ]
  by (simp del: moebius_rotation_inv)

lemma moebius_inv_rotation_rotation [simp]:
  shows "moebius_pt (moebius_rotation (-φ)) (moebius_pt (moebius_rotation φ) z) = z"
  using moebius_rotation_inv[symmetric, of φ]
  by (simp del: moebius_rotation_inv)

lemma moebius_pt_moebius_rotation [simp]:
  shows "moebius_pt (moebius_rotation φ) (of_complex z) = of_complex (cis φ * z)"
  unfolding moebius_rotation_def
  by simp

lemma moebius_pt_moebius_rotation_inf [simp]:
  shows "moebius_pt (moebius_rotation v) h = h"
  unfolding moebius_rotation_def
  by simp

lemma moebius_pt_rotation_inf_iff [simp]:
  shows "moebius_pt (moebius_rotation v) x = h  x = h"
  unfolding moebius_rotation_def
  using cis_neq_zero moebius_similarity_only_inf_to_inf
  by (simp del: moebius_pt_moebius_similarity)

lemma moebius_pt_moebius_rotation_zero [simp]:
  shows "moebius_pt (moebius_rotation φ) 0h = 0h"
  unfolding moebius_rotation_def 
  by simp

lemma moebius_pt_moebius_rotation_zero_iff [simp]:
  shows "moebius_pt (moebius_rotation φ) x = 0h  x = 0h"
  using moebius_pt_invert[of "moebius_rotation φ" x "0h"]
  by auto

lemma moebius_rotation_preserve_cmod [simp]:
  assumes "u  h"
  shows "cmod (to_complex (moebius_pt (moebius_rotation φ) u)) = cmod (to_complex u)"
  using assms
  using inf_or_of_complex[of u]
  by (auto simp: norm_mult)

(* -------------------------------------------------------------------------- *)
subsubsection ‹Dilatation›
(* -------------------------------------------------------------------------- *)

definition moebius_dilatation where
  "moebius_dilatation a = moebius_similarity (cor a) 0"

lemma moebius_dilatation_comp [simp]:
  assumes "a1 > 0" and "a2 > 0"
  shows "moebius_comp (moebius_dilatation a1) (moebius_dilatation a2) = moebius_dilatation (a1 * a2)"
  using assms                                  
  unfolding moebius_dilatation_def
  by simp

lemma moebius_dilatation_plus [simp]:
  assumes "a1 > 0" and "a2 > 0"
  shows "(moebius_dilatation a1) + (moebius_dilatation a2) = moebius_dilatation (a1 * a2)"
  using assms
  by simp

lemma moebius_dilatation_zero [simp]:
  shows "moebius_dilatation 1 = id_moebius"
  unfolding moebius_dilatation_def
  using moebius_similarity_id
  by simp

lemma moebius_dilatation_inverse [simp]:
  assumes "a > 0"
  shows "moebius_inv (moebius_dilatation a) = moebius_dilatation (1/a)"
  using assms
  unfolding moebius_dilatation_def
  by simp

lemma moebius_dilatation_uminus [simp]:
  assumes "a > 0"
  shows "- (moebius_dilatation a) = moebius_dilatation (1/a)"
  using assms
  by simp

lemma moebius_pt_dilatation [simp]:
  assumes "a  0"
  shows "moebius_pt (moebius_dilatation a) (of_complex z) = of_complex (cor a * z)"
  using assms
  unfolding moebius_dilatation_def
  by simp

(* -------------------------------------------------------------------------- *)
subsubsection ‹Rotation-dilatation›
(* -------------------------------------------------------------------------- *)

definition moebius_rotation_dilatation where
  "moebius_rotation_dilatation a = moebius_similarity a 0"

lemma moebius_rotation_dilatation:                                     
  assumes "a  0"
  shows "moebius_rotation_dilatation a = moebius_rotation (arg a) + moebius_dilatation (cmod a)"
  using assms
  unfolding moebius_rotation_dilatation_def moebius_rotation_def moebius_dilatation_def
  by simp

(* -------------------------------------------------------------------------- *)
subsubsection ‹Conjugate Möbius›
(* -------------------------------------------------------------------------- *)

text ‹Conjugation is not a Möbius transformation, and conjugate Möbius transformations (obtained
by conjugating each matrix element) do not represent conjugation function (although they are
somewhat related).›

lift_definition conjugate_moebius_mmat :: "moebius_mat  moebius_mat" is mat_cnj
  by auto
lift_definition conjugate_moebius :: "moebius  moebius" is conjugate_moebius_mmat
  by transfer (auto simp add: mat_cnj_def)

lemma conjugate_moebius:
  shows "conjugate  moebius_pt M = moebius_pt (conjugate_moebius M)  conjugate"
  apply (rule ext, simp)
  apply (transfer, transfer)
  using vec_cnj_mult_mv by auto


(* -------------------------------------------------------------------------- *)
subsection ‹Decomposition of M\"obius transformations›
(* -------------------------------------------------------------------------- *)

text ‹Every Euclidean similarity can be decomposed using translations, rotations, and dilatations.›
lemma similarity_decomposition:
  assumes "a  0"
  shows "moebius_similarity a b = (moebius_translation b) + (moebius_rotation (arg a)) + (moebius_dilatation (cmod a))"
proof-
  have "moebius_similarity a b = (moebius_translation b) + (moebius_rotation_dilatation a)"
    using assms
    unfolding moebius_rotation_dilatation_def moebius_translation_def moebius_similarity_def
    by auto
  thus ?thesis
    using moebius_rotation_dilatation [OF assms]
    by (auto simp add: add.assoc simp del: plus_moebius_def)
qed

text ‹A very important fact is that every Möbius transformation can be
composed of Euclidean similarities and a reciprocation.›
lemma moebius_decomposition:
  assumes "c  0" and "a*d - b*c  0"
  shows "mk_moebius a b c d =
             moebius_translation (a/c) +
             moebius_rotation_dilatation ((b*c - a*d)/(c*c)) +
             moebius_reciprocal +
             moebius_translation (d/c)"
  using assms
  unfolding moebius_rotation_dilatation_def moebius_translation_def moebius_similarity_def plus_moebius_def moebius_reciprocal_def
  by (simp add: field_simps) (transfer, transfer, auto simp add: field_simps, rule_tac x="1/c" in exI, simp)

lemma moebius_decomposition_similarity:
  assumes "a  0"
  shows "mk_moebius a b 0 d = moebius_similarity (a/d) (b/d)"
  using assms
  unfolding moebius_similarity_def
  by (transfer, transfer, auto, rule_tac x="1/d" in exI, simp)

text ‹Decomposition is used in many proofs. Namely, to show that every Möbius transformation has
some property, it suffices to show that reciprocation and all Euclidean similarities have that
property, and that the property is preserved under compositions.›
lemma wlog_moebius_decomposition:
  assumes
    trans: " v. P (moebius_translation v)" and
    rot: " α. P (moebius_rotation α)" and
    dil: " k. P (moebius_dilatation k)" and
    recip: "P (moebius_reciprocal)" and
    comp: " M1 M2. P M1; P M2  P (M1 + M2)"
  shows "P M"
proof-
    obtain a b c d where "M = mk_moebius a b c d" "mat_det (a, b, c, d)  0"
      using ex_mk_moebius[of M]
      by auto
    show ?thesis
    proof (cases "c = 0")
      case False
      show ?thesis
        using moebius_decomposition[of c a d b] ‹mat_det (a, b, c, d)  0 c  0 M = mk_moebius a b c d
        using moebius_rotation_dilatation[of "(b*c - a*d) / (c*c)"]
        using trans[of "a/c"] rot[of "arg ((b*c - a*d) / (c*c))"] dil[of "cmod ((b*c - a*d) / (c*c))"] recip
        using comp
        by (simp add: trans)
    next
      case True
      hence "M = moebius_similarity (a/d) (b/d)"
        using M = mk_moebius a b c d ‹mat_det (a, b, c, d)  0
        using moebius_decomposition_similarity
        by auto
      thus ?thesis
        using c = 0 ‹mat_det (a, b, c, d)  0
        using similarity_decomposition[of "a/d" "b/d"]
        using trans[of "b/d"] rot[of "arg (a/d)"] dil[of "cmod (a/d)"] comp
        by simp
    qed
qed

(* -------------------------------------------------------------------------- *)
subsection ‹Cross ratio and Möbius existence›
(* -------------------------------------------------------------------------- *)

text ‹For any fixed three points $z1$, $z2$ and $z3$, @{term "cross_ratio z z1 z2 z3"} can be seen as
a function of a single variable $z$.›


lemma is_moebius_cross_ratio:
  assumes "z1  z2" and  "z2  z3" and "z1  z3"
  shows "is_moebius (λ z. cross_ratio z z1 z2 z3)"
proof-
  have " M.  z. cross_ratio z z1 z2 z3 = moebius_pt M z"
    using assms
  proof (transfer, transfer)
    fix z1 z2 z3
    assume vz: "z1  vec_zero" "z2  vec_zero" "z3  vec_zero"
    obtain z1' z1'' where zz1: "z1 = (z1', z1'')"
      by (cases z1, auto)
    obtain z2' z2'' where zz2: "z2 = (z2', z2'')"
      by (cases z2, auto)
    obtain z3' z3'' where zz3: "z3 = (z3', z3'')"
      by (cases z3, auto)

    let ?m23 = "z2'*z3''-z3'*z2''"
    let ?m21 = "z2'*z1''-z1'*z2''"
    let ?m13 = "z1'*z3''-z3'*z1''"
    let ?M = "(z1''*?m23, -z1'*?m23, z3''*?m21, -z3'*?m21)"
    assume "¬ z1 v z2" "¬ z2 v z3" "¬ z1 v z3"
    hence *: "?m23  0" "?m21  0" "?m13  0"
      using vz zz1 zz2 zz3
      using complex_cvec_eq_mix[of z1' z1'' z2' z2'']
      using complex_cvec_eq_mix[of z1' z1'' z3' z3'']
      using complex_cvec_eq_mix[of z2' z2'' z3' z3'']
      by (auto simp del: complex_cvec_eq_def simp add: field_simps)

    have "mat_det ?M = ?m21*?m23*?m13"
      by (simp add: field_simps)
    hence "mat_det ?M  0"
      using *
      by simp
    moreover
    have "z{v. v  vec_zero}. cross_ratio_cvec z z1 z2 z3 v moebius_pt_cmat_cvec ?M z"
    proof
      fix z
      assume "z  {v. v  vec_zero}"
      hence "z  vec_zero"
        by simp
      obtain z' z'' where zz: "z = (z', z'')"
        by (cases z, auto)

      let ?m01 = "z'*z1''-z1'*z''"
      let ?m03 = "z'*z3''-z3'*z''"

      have "?m01  0  ?m03  0"
      proof (cases "z'' = 0  z1'' = 0  z3'' = 0")
        case True
        thus ?thesis
          using * z  vec_zero›  zz
          by auto
      next
        case False
        hence 1: "z''  0  z1''  0  z3''  0"
          by simp
        show ?thesis
        proof (rule ccontr)
          assume "¬ ?thesis"
          hence "z' * z1'' - z1' * z'' = 0" "z' * z3'' - z3' * z'' = 0"
            by auto
          hence "z1'/z1'' = z3'/z3''"
            using 1 zz z  vec_zero›
            by (metis frac_eq_eq right_minus_eq)
          thus False
            using * 1
            using frac_eq_eq
            by auto
        qed
      qed
      note * = * this
      show "cross_ratio_cvec z z1 z2 z3 v moebius_pt_cmat_cvec ?M z"
        using * zz zz1 zz2 zz3 mult_mv_nonzero[of "z" ?M] ‹mat_det ?M  0
        by simp (rule_tac x="1" in exI, simp add: field_simps)
    qed
    ultimately
    show "M{M. mat_det M  0}.
              z{v. v  vec_zero}. cross_ratio_cvec z z1 z2 z3 v moebius_pt_cmat_cvec M z"
      by blast
  qed
  thus ?thesis
    by (auto simp add: is_moebius_def)
qed

text ‹Using properties of the cross-ratio, it is shown that there is a Möbius transformation
mapping any three different points to $0_{hc}$, $1_{hc}$ and $\infty_{hc}$, respectively.›
lemma ex_moebius_01inf:
  assumes "z1  z2" and "z1  z3" and "z2  z3"
  shows " M. ((moebius_pt M z1 = 0h)  (moebius_pt M z2 = 1h)  (moebius_pt M z3 = h))"
  using assms
  using is_moebius_cross_ratio[OF z1  z2 z2  z3 z1  z3]
  using cross_ratio_0[OF z1  z2 z1  z3] cross_ratio_1[OF z1  z2 z2  z3] cross_ratio_inf[OF z1  z3 z2  z3]
  by (metis is_moebius_def)

text ‹There is a Möbius transformation mapping any three different points to any three different
points.›
lemma ex_moebius:
  assumes "z1  z2" and "z1  z3" and "z2  z3" 
          "w1  w2" and "w1  w3" and "w2  w3"
  shows " M. ((moebius_pt M z1 = w1)  (moebius_pt M z2 = w2)  (moebius_pt M z3 = w3))"
proof-
  obtain M1 where *: "moebius_pt M1 z1 = 0h  moebius_pt M1 z2 = 1h  moebius_pt M1 z3 = h"
    using ex_moebius_01inf[OF assms(1-3)]
    by auto
  obtain M2 where **: "moebius_pt M2 w1 = 0h  moebius_pt M2 w2 = 1h  moebius_pt M2 w3 = h"
    using ex_moebius_01inf[OF assms(4-6)]
    by auto
  let ?M = "moebius_comp (moebius_inv M2) M1"
  show ?thesis
    using * **
    by (rule_tac x="?M" in exI, auto simp add: moebius_pt_invert)
qed

lemma ex_moebius_1:
  shows " M. moebius_pt M z1 = w1"
proof-
  obtain z2 z3 where "z1  z2" "z1  z3" "z2  z3"
    using ex_3_different_points[of z1]
    by auto
  moreover
  obtain w2 w3 where "w1  w2" "w1  w3" "w2  w3"
    using ex_3_different_points[of w1]
    by auto
  ultimately
  show ?thesis
    using ex_moebius[of z1 z2 z3 w1 w2 w3]
    by auto
qed

text ‹The next lemma turns out to have very important applications in further proof development, as
it enables so called ,,without-loss-of-generality (wlog)'' reasoning \cite{wlog}. Namely, if the
property is preserved under Möbius transformations, then instead of three arbitrary different
points one can consider only the case of points $0_{hc}$, $1_{hc}$, and $\infty_{hc}$.›
lemma wlog_moebius_01inf:
  fixes M::moebius
  assumes "P 0h 1h h" and "z1  z2" and "z2  z3" and "z1  z3"
   " M a b c. P a b c  P (moebius_pt M a) (moebius_pt M b) (moebius_pt M c)"
  shows "P z1 z2 z3"
proof-
  from assms obtain M where *:
    "moebius_pt M z1 = 0h"  "moebius_pt M z2 = 1h"   "moebius_pt M z3 = h"
    using ex_moebius_01inf[of z1 z2 z3]
    by auto
  have **: "moebius_pt (moebius_inv M) 0h = z1"  "moebius_pt (moebius_inv M) 1h = z2" "moebius_pt (moebius_inv M) h = z3"
    by (subst *[symmetric], simp)+
  thus ?thesis
    using assms
    by auto
qed

(* -------------------------------------------------------------------------- *)
subsection ‹Fixed points and Möbius transformation uniqueness›
(* -------------------------------------------------------------------------- *)

lemma three_fixed_points_01inf:
  assumes "moebius_pt M 0h = 0h" and "moebius_pt M 1h = 1h" and "moebius_pt M h = h"
  shows "M = id_moebius"
  using assms
  by (transfer, transfer, auto)

lemma three_fixed_points:
  assumes "z1  z2" and "z1  z3" and "z2  z3"
  assumes "moebius_pt M z1 = z1" and "moebius_pt M z2 = z2" and "moebius_pt M z3 = z3"
  shows "M = id_moebius"
proof-
  from assms obtain M' where *: "moebius_pt M' z1 = 0h"  "moebius_pt M' z2 = 1h"   "moebius_pt M' z3 = h"
    using ex_moebius_01inf[of z1 z2 z3]
    by auto
  have **: "moebius_pt (moebius_inv M') 0h = z1"  "moebius_pt (moebius_inv M') 1h = z2" "moebius_pt (moebius_inv M') h = z3"
    by (subst *[symmetric], simp)+

  have "M' + M + (-M') = 0"
    unfolding zero_moebius_def
    apply (rule three_fixed_points_01inf)
    using * ** assms
    by (simp add: moebius_comp[symmetric])+
  thus ?thesis
    by (metis eq_neg_iff_add_eq_0 minus_add_cancel zero_moebius_def)
qed

lemma unique_moebius_three_points:
  assumes "z1  z2" and "z1  z3" and "z2  z3"
  assumes "moebius_pt M1 z1 = w1" and "moebius_pt M1 z2 = w2" and "moebius_pt M1 z3 = w3"
          "moebius_pt M2 z1 = w1" and "moebius_pt M2 z2 = w2" and "moebius_pt M2 z3 = w3"
  shows "M1 = M2"
proof-
  let ?M = "moebius_comp (moebius_inv M2) M1"
  have "moebius_pt ?M z1 = z1"
    using ‹moebius_pt M1 z1 = w1 ‹moebius_pt M2 z1 = w1
    by (auto simp add: moebius_pt_invert)
  moreover
  have "moebius_pt ?M z2 = z2"
    using ‹moebius_pt M1 z2 = w2 ‹moebius_pt M2 z2 = w2
    by (auto simp add: moebius_pt_invert)
  moreover
  have "moebius_pt ?M z3 = z3"
    using ‹moebius_pt M1 z3 = w3 ‹moebius_pt M2 z3 = w3
    by (auto simp add: moebius_pt_invert)
  ultimately
  have "?M = id_moebius"
    using assms three_fixed_points
    by auto
  thus ?thesis
    by (metis add_minus_cancel left_minus plus_moebius_def uminus_moebius_def zero_moebius_def)
qed

text ‹There is a unique Möbius transformation mapping three different points to other three
different points.›

lemma ex_unique_moebius_three_points:
  assumes "z1  z2" and "z1  z3" and "z2  z3" 
          "w1  w2" and "w1  w3" and "w2  w3"
  shows "∃! M. ((moebius_pt M z1 = w1)  (moebius_pt M z2 = w2)  (moebius_pt M z3 = w3))"
proof-
  obtain M where *: "moebius_pt M z1 = w1  moebius_pt M z2 = w2  moebius_pt M z3 = w3"
    using ex_moebius[OF assms]
    by auto
  show ?thesis
    unfolding Ex1_def
  proof (rule_tac x="M" in exI, rule)
    show "y. moebius_pt y z1 = w1  moebius_pt y z2 = w2  moebius_pt y z3 = w3  y = M"
      using *
      using unique_moebius_three_points[OF assms(1-3)]
      by simp
  qed (simp add: *)
qed

lemma ex_unique_moebius_three_points_fun:
  assumes "z1  z2" and "z1  z3" and "z2  z3" 
          "w1  w2" and "w1  w3" and "w2  w3"
  shows "∃! f. is_moebius f  (f z1 = w1)  (f z2 = w2)  (f z3 = w3)"
proof-
  obtain M where "moebius_pt M z1 = w1" "moebius_pt M z2 = w2" "moebius_pt M z3 = w3"
    using ex_unique_moebius_three_points[OF assms]
    by auto
  thus ?thesis
    using ex_unique_moebius_three_points[OF assms]
    unfolding Ex1_def
    by (rule_tac x="moebius_pt M" in exI) (auto simp add: is_moebius_def)
qed

text ‹Different Möbius transformations produce different actions.›
lemma unique_moebius_pt:
  assumes "moebius_pt M1 = moebius_pt M2"
  shows "M1 = M2"
  using assms unique_moebius_three_points[of "0h" "1h" "h"]
  by auto

lemma is_cross_ratio_01inf:
  assumes "z1  z2" and "z1  z3" and "z2  z3" and "is_moebius f"
  assumes "f z1 = 0h" and "f z2 = 1h" and "f z3 = h"
  shows "f = (λ z. cross_ratio z z1 z2 z3)"
  using assms
  using cross_ratio_0[OF z1  z2 z1  z3] cross_ratio_1[OF z1  z2 z2  z3] cross_ratio_inf[OF z1  z3 z2  z3]
  using is_moebius_cross_ratio[OF z1  z2 z2  z3 z1  z3]
  using ex_unique_moebius_three_points_fun[OF z1  z2 z1  z3 z2  z3, of "0h" "1h" "h"]
  by auto

text ‹Möbius transformations preserve cross-ratio.›
lemma moebius_preserve_cross_ratio [simp]:
  assumes "z1  z2" and "z1  z3" and "z2  z3"
  shows "cross_ratio (moebius_pt M z) (moebius_pt M z1) (moebius_pt M z2) (moebius_pt M z3) =
         cross_ratio z z1 z2 z3"
proof-
  let ?f = "λ z. cross_ratio z z1 z2 z3"
  let ?M = "moebius_pt M"
  let ?iM = "inv ?M"
  have "(?f  ?iM) (?M z1) = 0h"
    using bij_moebius_pt[of M] cross_ratio_0[OF z1  z2 z1  z3]
    by (simp add: bij_def)
  moreover
  have "(?f  ?iM) (?M z2) = 1h"
    using bij_moebius_pt[of M]  cross_ratio_1[OF z1  z2 z2  z3]
    by (simp add: bij_def)
  moreover
  have "(?f  ?iM) (?M z3) = h"
    using bij_moebius_pt[of M] cross_ratio_inf[OF z1  z3 z2  z3]
    by (simp add: bij_def)
  moreover
  have "is_moebius (?f  ?iM)"
    by (rule is_moebius_comp, rule is_moebius_cross_ratio[OF z1  z2 z2  z3 z1  z3], rule is_moebius_inv, auto simp add: is_moebius_def)
  moreover
  have "?M z1  ?M z2" "?M z1  ?M z3"  "?M z2  ?M z3"
    using assms
    by simp_all
  ultimately
  have "?f  ?iM = (λ z. cross_ratio z (?M z1) (?M z2) (?M z3))"
    using assms
    using is_cross_ratio_01inf[of "?M z1" "?M z2" "?M z3" "?f  ?iM"]
    by simp
  moreover
  have "(?f  ?iM) (?M z) = cross_ratio z z1 z2 z3"
    using bij_moebius_pt[of M]
    by (simp add: bij_def)                             
  moreover
  have "(λ z. cross_ratio z (?M z1) (?M z2) (?M z3)) (?M z) = cross_ratio (?M z) (?M z1) (?M z2) (?M z3)"
    by simp
  ultimately
  show ?thesis
    by simp
qed

lemma conjugate_cross_ratio [simp]:                                  
  assumes "z1  z2" and "z1  z3" and "z2  z3"
  shows "cross_ratio (conjugate z) (conjugate z1) (conjugate z2) (conjugate z3) =
         conjugate (cross_ratio z z1 z2 z3)"
proof-
  let ?f = "λ z. cross_ratio z z1 z2 z3"
  let ?M = "conjugate"
  let ?iM = "conjugate"
  have "(conjugate  ?f  ?iM) (?M z1) = 0h"
    using cross_ratio_0[OF z1  z2 z1  z3]
    by simp
  moreover
  have "(conjugate  ?f  ?iM) (?M z2) = 1h"
    using cross_ratio_1[OF z1  z2 z2  z3]
    by simp
  moreover
  have "(conjugate  ?f  ?iM) (?M z3) = h"
    using cross_ratio_inf[OF z1  z3 z2  z3]
    by simp
  moreover
  have "is_moebius (conjugate  ?f  ?iM)"
  proof-
    obtain M where "?f = moebius_pt M"
      using is_moebius_cross_ratio[OF z1  z2 z2  z3 z1  z3]
      by (auto simp add: is_moebius_def)
    thus ?thesis
      using conjugate_moebius[of M]
      by (auto simp add: comp_assoc is_moebius_def)
  qed
  moreover
  have "?M z1  ?M z2" "?M z1  ?M z3"  "?M z2  ?M z3"
    using assms
    by (auto simp add: conjugate_inj)
  ultimately
  have "conjugate  ?f  ?iM = (λ z. cross_ratio z (?M z1) (?M z2) (?M z3))"
    using assms
    using is_cross_ratio_01inf[of "?M z1" "?M z2" "?M z3" "conjugate  ?f  ?iM"]
    by simp
  moreover
  have "(conjugate  ?f  ?iM) (?M z) = conjugate (cross_ratio z z1 z2 z3)"
    by simp
  moreover
  have "(λ z. cross_ratio z (?M z1) (?M z2) (?M z3)) (?M z) = cross_ratio (?M z) (?M z1) (?M z2) (?M z3)"
    by simp
  ultimately
  show ?thesis
    by simp
qed

lemma cross_ratio_reciprocal [simp]:
  assumes "u  v" and "v  w" and "u  w"
  shows "cross_ratio (reciprocal z) (reciprocal u) (reciprocal v) (reciprocal w) = 
         cross_ratio z u v w"
  using assms
  by (subst moebius_reciprocal[symmetric])+ (simp del: moebius_reciprocal)                           

lemma cross_ratio_inversion [simp]:
  assumes "u  v" and "v  w" and "u  w"
  shows "cross_ratio (inversion z) (inversion u) (inversion v) (inversion w) = 
         conjugate (cross_ratio z u v w)"
proof-                                               
  have "reciprocal u  reciprocal v" "reciprocal u  reciprocal w" "reciprocal v  reciprocal w"
    using assms
    by ((subst moebius_reciprocal[symmetric])+, simp del: moebius_reciprocal)+
  thus ?thesis
    using assms
    unfolding inversion_def
    by simp
qed


lemma fixed_points_0inf':
  assumes "moebius_pt M 0h = 0h" and "moebius_pt M h = h"
  shows " k::complex_homo. (k  0h  k  h)  ( z. moebius_pt M z = k *h z)"
using assms
proof (transfer, transfer)
  fix M :: complex_mat
  assume "mat_det M  0"
  obtain a b c d where MM: "M = (a, b, c, d)"
    by (cases M) auto
  assume "moebius_pt_cmat_cvec M 0v v 0v" "moebius_pt_cmat_cvec M v v v"
  hence *: "b = 0" "c = 0" "a  0  d  0"
    using MM
    by auto
  let ?z = "(a, d)"
  have "?z  vec_zero"
    using *
    by simp
  moreover
  have "¬ ?z v 0v  ¬ ?z v v"
    using *
    by simp
  moreover
  have "z{v. v  vec_zero}. moebius_pt_cmat_cvec M z v ?z *v z"
    using MM ‹mat_det M  0 *
    by force
  ultimately
  show "k{v. v  vec_zero}.
                   (¬ k v 0v  ¬ k v v) 
                   (z{v. v  vec_zero}. moebius_pt_cmat_cvec M z v k *v z)"
    by blast
qed

lemma fixed_points_0inf:
  assumes "moebius_pt M 0h = 0h" and "moebius_pt M h = h"
  shows " k::complex_homo. (k  0h  k  h)  moebius_pt M = (λ z. k *h z)"
  using fixed_points_0inf'[OF assms]
  by auto

lemma ex_cross_ratio:
  assumes "u  v" and "u  w" and "v  w"
  shows " z. cross_ratio z u v w = c"
proof-
  obtain M where "(λ z. cross_ratio z u v w) = moebius_pt M"    
    using assms is_moebius_cross_ratio[of u v w]
    unfolding is_moebius_def
    by auto
  hence *: " z. cross_ratio z u v w = moebius_pt M z"
    by metis
  let ?z = "moebius_pt (-M) c"
  have "cross_ratio ?z u v w = c"
    using *
    by auto
  thus ?thesis
    by auto
qed

lemma unique_cross_ratio:
  assumes "u  v" and "v  w" and "u  w"
  assumes "cross_ratio z u v w = cross_ratio z' u v w"
  shows "z = z'"
proof-
  obtain M where "(λ z. cross_ratio z u v w) = moebius_pt M"
    using is_moebius_cross_ratio[OF assms(1-3)]
    unfolding is_moebius_def
    by auto
  hence "moebius_pt M z = moebius_pt M z'"
    using assms(4)
    by metis
  thus ?thesis
    using moebius_pt_eq_I
    by metis
qed

lemma ex1_cross_ratio:
  assumes "u  v" and "u  w" and "v  w"
  shows "∃! z. cross_ratio z u v w = c"
  using assms ex_cross_ratio[OF assms, of c] unique_cross_ratio[of u v w]
  by blast

(* -------------------------------------------------------------------------- *)
subsection ‹Pole›
(* -------------------------------------------------------------------------- *)

definition is_pole :: "moebius  complex_homo  bool" where
  "is_pole M z  moebius_pt M z = h"

lemma ex1_pole:
  shows "∃! z. is_pole M z"
  using bij_moebius_pt[of M]
  unfolding is_pole_def bij_def inj_on_def surj_def
  unfolding Ex1_def
  by (metis UNIV_I)

definition pole :: "moebius  complex_homo" where
  "pole M = (THE z. is_pole M z)"

lemma pole_mk_moebius:
  assumes "is_pole (mk_moebius a b c d) z" and "c  0" and "a*d - b*c  0"
  shows "z = of_complex (-d/c)"
proof-
  let ?t1 = "moebius_translation (a / c)"
  let ?rd = "moebius_rotation_dilatation ((b * c - a * d) / (c * c))"
  let ?r = "moebius_reciprocal"                                                 
  let ?t2 = "moebius_translation (d / c)"
  have "moebius_pt (?rd + ?r + ?t2) z = h"
    using assms
    unfolding is_pole_def
    apply (subst (asm) moebius_decomposition)
    apply (auto simp add: moebius_comp[symmetric] moebius_translation_def)
    apply (subst moebius_similarity_only_inf_to_inf[of 1 "a/c"], auto)
    done
  hence "moebius_pt (?r + ?t2) z = h"
    using a*d - b*c  0 c  0
    unfolding moebius_rotation_dilatation_def
    by (simp del: moebius_pt_moebius_similarity)
  hence "moebius_pt ?t2 z = 0h"
    by simp
  thus ?thesis
    using moebius_pt_invert[of ?t2 z "0h"]
    by simp ((subst (asm) of_complex_zero[symmetric])+, simp del: of_complex_zero)
qed

lemma pole_similarity:
  assumes "is_pole (moebius_similarity a b) z" and "a  0"
  shows "z = h"
  using assms
  unfolding is_pole_def
  using moebius_similarity_only_inf_to_inf[of a b z]
  by simp

(* -------------------------------------------------------------------------- *)
subsection ‹Homographies and antihomographies›
(* -------------------------------------------------------------------------- *)

text ‹Inversion is not a Möbius transformation (it is a canonical example of so called
anti-Möbius transformations, or antihomographies). All antihomographies are compositions of
homographies and conjugation. The fundamental theorem of projective geometry (that we shall not
prove) states that all automorphisms (bijective functions that preserve the cross-ratio) of
$\mathbb{C}P^1$ are either homographies or antihomographies.›

definition is_homography :: "(complex_homo  complex_homo)  bool" where
 "is_homography f  is_moebius f"

definition is_antihomography :: "(complex_homo  complex_homo)  bool" where
 "is_antihomography f  ( f'. is_moebius f'  f = f'  conjugate)"

text ‹Conjugation is not a Möbius transformation, but is antihomograhpy.›
lemma not_moebius_conjugate: 
  shows "¬ is_moebius conjugate"
proof
  assume "is_moebius conjugate"
  then obtain M where *: "moebius_pt M = conjugate"
    unfolding is_moebius_def
    by metis
  hence "moebius_pt M 0h = 0h" "moebius_pt M 1h = 1h" "moebius_pt M h = h"
    by auto
  hence "M = id_moebius"
    using three_fixed_points_01inf
    by auto
  hence "conjugate = id"
    using *
    by simp
  moreover
  have "conjugate iih  iih"
    using of_complex_inj[of "𝗂" "-𝗂"]
    by (subst of_complex_ii[symmetric])+ (auto simp del: of_complex_ii)
  ultimately
  show False
    by simp
qed

lemma conjugation_is_antihomography[simp]:
  shows "is_antihomography conjugate"
  unfolding is_antihomography_def
  by (rule_tac x="id" in exI, metis fun.map_id0 id_apply is_moebius_def moebius_pt_moebius_id)

lemma inversion_is_antihomography [simp]: 
  shows "is_antihomography inversion"
  using moebius_reciprocal
  unfolding inversion_sym is_antihomography_def is_moebius_def
  by metis

text ‹Functions cannot simultaneously be homographies and antihomographies - the disjunction is exclusive.›
lemma homography_antihomography_exclusive:
  assumes "is_antihomography f"
  shows "¬ is_homography f"
proof
  assume "is_homography f"
  then obtain M where "f = moebius_pt M"
    unfolding is_homography_def is_moebius_def
    by auto
  then obtain M' where "moebius_pt M = moebius_pt M'  conjugate"
    using assms
    unfolding is_antihomography_def is_moebius_def
    by auto
  hence "conjugate = moebius_pt (-M')  moebius_pt M"
    by auto
  hence "conjugate = moebius_pt (-M' + M)"
    by (simp add: moebius_comp)
  thus False
    using not_moebius_conjugate
    unfolding is_moebius_def
    by metis
qed


(* -------------------------------------------------------------------------- *)
subsection ‹Classification of Möbius transformations›
(* -------------------------------------------------------------------------- *)

text ‹Möbius transformations can be classified to parabolic, elliptic and loxodromic. We do not
develop this part of the theory in depth.›

lemma similarity_scale_1:
  assumes "k  0"
  shows "similarity (k *sm I) M = similarity I M"
  using assms
  unfolding similarity_def
  using mat_inv_mult_sm[of k I]
  by simp

lemma similarity_scale_2:
  shows "similarity I (k *sm M) = k *sm (similarity I M)"
  unfolding similarity_def
  by auto

lemma mat_trace_mult_sm [simp]:
  shows "mat_trace (k *sm M) = k * mat_trace M"
  by (cases M) (simp add: field_simps)

definition moebius_mb_cmat :: "complex_mat  complex_mat  complex_mat" where
  [simp]: "moebius_mb_cmat I M = similarity I M"

lift_definition moebius_mb_mmat :: "moebius_mat  moebius_mat  moebius_mat" is moebius_mb_cmat
  by (simp add: similarity_def mat_det_inv)

lift_definition moebius_mb :: "moebius  moebius  moebius" is moebius_mb_mmat
proof transfer
  fix M M' I I'
  assume "moebius_cmat_eq M M'" "moebius_cmat_eq I I'"
  thus "moebius_cmat_eq (moebius_mb_cmat I M) (moebius_mb_cmat I' M')"
    by (auto simp add: similarity_scale_1 similarity_scale_2)
qed

definition similarity_invar_cmat :: "complex_mat  complex" where
  [simp]: "similarity_invar_cmat M = (mat_trace M)2 / mat_det M - 4"

lift_definition similarity_invar_mmat :: "moebius_mat  complex" is similarity_invar_cmat
  done

lift_definition similarity_invar :: "moebius  complex" is similarity_invar_mmat
  by transfer (auto simp add: power2_eq_square field_simps)

lemma similarity_invar_moeibus_mb:
  shows "similarity_invar (moebius_mb I M) = similarity_invar M"
  by (transfer, transfer, simp)

definition similar :: "moebius  moebius  bool" where
  "similar M1 M2  ( I. moebius_mb I M1 = M2)"

lemma similar_refl [simp]:
  shows "similar M M"
  unfolding similar_def
  by (rule_tac x="id_moebius" in exI) (transfer, transfer, simp)

lemma similar_sym:
  assumes "similar M1 M2"
  shows "similar M2 M1"
proof-
  from assms obtain I where "M2 = moebius_mb I M1"
    unfolding similar_def
    by auto
  hence "M1 = moebius_mb (moebius_inv I) M2"
  proof (transfer, transfer)
    fix M2 I M1
    assume "moebius_cmat_eq M2 (moebius_mb_cmat I M1)" "mat_det I  0"
    then obtain k where "k  0" "similarity I M1 = k *sm M2"
      by auto
    thus "moebius_cmat_eq M1 (moebius_mb_cmat (moebius_inv_cmat I) M2)"
      using similarity_inv[of I M1 "k *sm M2", OF _ ‹mat_det I  0]
      by (auto simp add: similarity_scale_2) (rule_tac x="1/k" in exI, simp)
  qed
  thus ?thesis
    unfolding similar_def
    by auto
qed

lemma similar_trans:
  assumes "similar M1 M2" and "similar M2 M3"
  shows "similar M1 M3"
proof-
  obtain I1 I2 where "moebius_mb I1 M1 = M2" "moebius_mb I2 M2 = M3"
    using assms
    by (auto simp add: similar_def)
  thus ?thesis
    unfolding similar_def
  proof (rule_tac x="moebius_comp I1 I2" in exI, transfer, transfer)
    fix I1 I2 M1 M2 M3
    assume "moebius_cmat_eq (moebius_mb_cmat I1 M1) M2"
           "moebius_cmat_eq (moebius_mb_cmat I2 M2) M3"
           "mat_det I1  0" "mat_det I2  0"
    thus "moebius_cmat_eq (moebius_mb_cmat (moebius_comp_cmat I1 I2) M1) M3"
      by (auto simp add: similarity_scale_2) (rule_tac x="ka*k" in exI, simp)
  qed
qed

end

Theory Circlines

(* ---------------------------------------------------------------------------- *)
section ‹Circlines›
(* ---------------------------------------------------------------------------- *)
theory Circlines
  imports More_Set Moebius Hermitean_Matrices Elementary_Complex_Geometry
begin

(* ----------------------------------------------------------------- *)
subsection ‹Definition of circlines›
(* ----------------------------------------------------------------- *)

text ‹In our formalization we follow the approach described by Schwerdtfeger
\cite{schwerdtfeger} and represent circlines by Hermitean, non-zero
$2\times 2$ matrices. In the original formulation, a matrix
$\left(\begin{array}{cc}A & B\\C & D\end{array}\right)$ corresponds to
the equation $A\cdot z\cdot \overline{z} + B\cdot \overline{z} + C\cdot z + D = 0$,
where $C = \overline{B}$ and $A$ and $D$ are real (as the matrix is
Hermitean).›

abbreviation hermitean_nonzero where
  "hermitean_nonzero  {H. hermitean H  H  mat_zero}"

typedef circline_mat = hermitean_nonzero
by (rule_tac x="eye" in exI) (auto simp add: hermitean_def mat_adj_def mat_cnj_def)

setup_lifting type_definition_circline_mat


definition circline_eq_cmat :: "complex_mat  complex_mat  bool" where
 [simp]: "circline_eq_cmat A B  ( k::real. k  0  B = cor k *sm A)"

lemma symp_circline_eq_cmat: "symp circline_eq_cmat"
  unfolding symp_def
proof ((rule allI)+, rule impI)
  fix x y
  assume "circline_eq_cmat x y"
  then obtain k where "k  0  y = cor k *sm x"
    by auto
  hence  "1 / k  0  x = cor (1 / k) *sm y"
    by auto
  thus "circline_eq_cmat y x"
    unfolding circline_eq_cmat_def
    by blast
qed

text‹Hermitean non-zero matrices are equivalent only to such matrices›
lemma circline_eq_cmat_hermitean_nonzero:
  assumes "hermitean H  H  mat_zero" "circline_eq_cmat H H'"
  shows "hermitean H'  H'  mat_zero"
  using assms
  by (metis circline_eq_cmat_def hermitean_mult_real nonzero_mult_real of_real_eq_0_iff)


lift_definition circline_eq_clmat :: "circline_mat  circline_mat  bool" is circline_eq_cmat
  done

lemma circline_eq_clmat_refl [simp]: "circline_eq_clmat H H"
  by transfer (simp, rule_tac x="1" in exI, simp)

quotient_type circline = circline_mat / circline_eq_clmat
proof (rule equivpI)
  show "reflp circline_eq_clmat"
    unfolding reflp_def
    by transfer (auto, rule_tac x="1" in exI, simp)
next
  show "symp circline_eq_clmat"
    unfolding symp_def
    by transfer (auto, (rule_tac x="1/k" in exI, simp)+)
next
  show "transp circline_eq_clmat"
    unfolding transp_def
    by transfer (simp, safe, (rule_tac x="ka*k" in exI, simp)+)
qed

text ‹Circline with specified matrix›

text ‹An auxiliary constructor @{term mk_circline} returns a circline (an
equivalence class) for given four complex numbers $A$, $B$, $C$ and
$D$ (provided that they form a Hermitean, non-zero matrix).›

definition mk_circline_cmat :: "complex  complex  complex  complex  complex_mat" where
[simp]: "mk_circline_cmat A B C D =
          (let M = (A, B, C, D)
            in if M  hermitean_nonzero then
                  M
               else
                  eye)"

lift_definition mk_circline_clmat :: "complex  complex  complex  complex  circline_mat" is mk_circline_cmat
  by (auto simp add: Let_def hermitean_def mat_adj_def mat_cnj_def)

lift_definition mk_circline :: "complex  complex  complex  complex  circline" is mk_circline_clmat
  done

lemma ex_mk_circline:
  shows " A B C D. H = mk_circline A B C D  hermitean (A, B, C, D)  (A, B, C, D)  mat_zero"
proof (transfer, transfer)
  fix H
  assume *: "hermitean H  H  mat_zero"
  obtain A B C D where "H = (A, B, C, D)"
    by (cases " H", auto)
  hence "circline_eq_cmat H (mk_circline_cmat A B C D)  hermitean (A, B, C, D)  (A, B, C, D)  mat_zero"
    using *
    by auto
  thus " A B C D. circline_eq_cmat H (mk_circline_cmat A B C D)  hermitean (A, B, C, D)  (A, B, C, D)  mat_zero"
    by blast
qed

(* ----------------------------------------------------------------- *)
subsection ‹Circline type›
(* ----------------------------------------------------------------- *)

definition circline_type_cmat :: "complex_mat  real" where
  [simp]: "circline_type_cmat H = sgn (Re (mat_det H))"

lift_definition circline_type_clmat :: "circline_mat  real" is circline_type_cmat
  done

lift_definition circline_type :: "circline  real" is circline_type_clmat
  by transfer (simp, erule exE, simp add: sgn_mult)

lemma circline_type: "circline_type H = -1  circline_type H = 0  circline_type H = 1"
  by (transfer, transfer, simp add: sgn_if)

lemma circline_type_mk_circline [simp]:
  assumes "(A, B, C, D)  hermitean_nonzero"
  shows  "circline_type (mk_circline A B C D) = sgn (Re (A*D - B*C))"
  using assms
  by (transfer, transfer, simp)

(* ----------------------------------------------------------------- *)
subsection ‹Points on the circline›
(* ----------------------------------------------------------------- *)

text ‹Each circline determines a corresponding set of points. Again, a description given in
homogeneous coordinates is a bit better than the original description defined only for ordinary
complex numbers. The point with homogeneous coordinates $(z_1, z_2)$ will belong to the set of
circline points iff $A \cdot z_1\cdot \overline{z_1} + B\cdot \overline{z_1} \cdot z_2 + C\cdot z_1 \cdot\overline{z_2} +
D\cdot z_2 \cdot \overline{z_2} = 0$. Note that this is a quadratic form determined by a vector of
homogeneous coordinates and the Hermitean matrix.›

definition on_circline_cmat_cvec :: "complex_mat  complex_vec  bool" where
  [simp]: "on_circline_cmat_cvec H z  quad_form z H = 0"

lift_definition on_circline_clmat_hcoords :: "circline_mat  complex_homo_coords  bool" is on_circline_cmat_cvec
  done

lift_definition on_circline :: "circline  complex_homo  bool" is on_circline_clmat_hcoords
  by transfer (simp del: quad_form_def, (erule exE)+, simp del: quad_form_def add: quad_form_scale_m quad_form_scale_v)

definition circline_set :: "circline  complex_homo set" where
  "circline_set H = {z. on_circline H z}"

lemma circline_set_I [simp]:
  assumes "on_circline H z"
  shows "z  circline_set H"
  using assms
  unfolding circline_set_def
  by auto

abbreviation circline_equation where
  "circline_equation A B C D z1 z2  A*z1*cnj z1 + B*z2*cnj z1 + C*cnj z2*z1 + D*z2*cnj z2 = 0"

lemma on_circline_cmat_cvec_circline_equation:
  "on_circline_cmat_cvec (A, B, C, D) (z1, z2)  circline_equation A B C D z1 z2"
  by (simp add: vec_cnj_def field_simps)

lemma circline_equation:
  assumes "H = mk_circline A B C D" and "(A, B, C, D)  hermitean_nonzero"
  shows "of_complex z  circline_set H  circline_equation A B C D z 1"
  using assms
  unfolding circline_set_def
  by simp (transfer, transfer, simp add: vec_cnj_def field_simps)

text ‹Circlines trough 0 and inf.›
text ‹The circline represents a line when $A=0$ or a circle, otherwise.›

definition circline_A0_cmat :: "complex_mat  bool" where
  [simp]: "circline_A0_cmat H  (let (A, B, C, D) = H in A = 0)"
lift_definition circline_A0_clmat :: "circline_mat  bool" is circline_A0_cmat
  done
lift_definition circline_A0 :: "circline  bool" is circline_A0_clmat
  by transfer auto

abbreviation is_line where
  "is_line H  circline_A0 H"

abbreviation is_circle where
  "is_circle H  ¬ circline_A0 H"

definition circline_D0_cmat :: "complex_mat  bool" where
  [simp]: "circline_D0_cmat H  (let (A, B, C, D) = H in D = 0)"
lift_definition circline_D0_clmat :: "circline_mat  bool" is circline_D0_cmat
  done
lift_definition circline_D0 :: "circline  bool" is circline_D0_clmat
  by transfer auto

lemma inf_on_circline: "on_circline H h  circline_A0 H"
  by (transfer, transfer, auto simp add: vec_cnj_def)

lemma
  inf_in_circline_set: "h  circline_set H  is_line H"
  using inf_on_circline
  unfolding circline_set_def
  by simp

lemma zero_on_circline: "on_circline H 0h  circline_D0 H"
  by (transfer, transfer, auto simp add: vec_cnj_def)

lemma
  zero_in_circline_set: "0h  circline_set H  circline_D0 H"
  using zero_on_circline
  unfolding circline_set_def
  by simp

(* ----------------------------------------------------------------- *)
subsection ‹Connection with circles and lines in the classic complex plane›
(* ----------------------------------------------------------------- *)

text ‹Every Euclidean circle and Euclidean line can be represented by a
circline.›

lemma classic_circline:
  assumes "H = mk_circline A B C D" and "hermitean (A, B, C, D)  (A, B, C, D)  mat_zero"
  shows "circline_set H - {h} = of_complex ` circline (Re A) B (Re D)"
using assms
unfolding circline_set_def
proof (safe)
  fix z
  assume "hermitean (A, B, C, D)" "(A, B, C, D)  mat_zero" "z  circline (Re A) B (Re D)"
    thus "on_circline (mk_circline A B C D) (of_complex z)"
      using hermitean_elems[of A B C D]
      by (transfer, transfer) (auto simp add: circline_def vec_cnj_def field_simps)
next
  fix z
  assume "of_complex z = h"
  thus False
    by simp
next
  fix z
  assume "hermitean (A, B, C, D)" "(A, B, C, D)  mat_zero" "on_circline (mk_circline A B C D) z" "z  of_complex ` circline (Re A) B (Re D)"
  moreover
  have "z  h  z  of_complex ` circline (Re A) B (Re D)"
  proof
    assume "z  h"
    show "z  of_complex ` circline (Re A) B (Re D)"
    proof
      show "z = of_complex (to_complex z)"
        using z  h
        by simp
    next
      show "to_complex z  circline (Re A) B (Re D)"
        using ‹on_circline (mk_circline A B C D) z z  h
        using ‹hermitean (A, B, C, D) (A, B, C, D)  mat_zero›
      proof (transfer, transfer)
        fix A B C D and z :: complex_vec
        obtain z1 z2 where zz: "z = (z1, z2)"
          by (cases z, auto)
        assume *: "z  vec_zero"  "¬ z v v"
                  "on_circline_cmat_cvec (mk_circline_cmat A B C D) z"
                  "hermitean (A, B, C, D)" "(A, B, C, D)  mat_zero"
        have "z2  0"
          using z  vec_zero› ¬ z v v
          using inf_cvec_z2_zero_iff zz
          by blast
        thus "to_complex_cvec z  circline (Re A) B (Re D)"
          using * zz
          using hermitean_elems[of A B C D]
          by (simp add: vec_cnj_def circline_def field_simps)
      qed
    qed
  qed
  ultimately
  show "z = h"
    by simp
qed

text ‹The matrix of the circline representing circle determined with center and radius.›
definition mk_circle_cmat :: "complex  real  complex_mat" where
  [simp]: "mk_circle_cmat a r = (1, -a, -cnj a, a*cnj a - cor r*cor r)"

lift_definition mk_circle_clmat :: "complex  real  circline_mat" is mk_circle_cmat
  by (simp add: hermitean_def mat_adj_def mat_cnj_def)

lift_definition mk_circle :: "complex  real  circline" is mk_circle_clmat
  done

lemma is_circle_mk_circle: "is_circle (mk_circle a r)"
  by (transfer, transfer, simp)

lemma circline_set_mk_circle [simp]:
  assumes "r  0"
  shows "circline_set (mk_circle a r) = of_complex ` circle a r"
proof-
  let ?A = "1" and ?B = "-a" and ?C = "-cnj a" and ?D = "a*cnj a - cor r*cor r"
  have *: "(?A, ?B, ?C, ?D)  {H. hermitean H  H  mat_zero}"
    by (simp add: hermitean_def mat_adj_def mat_cnj_def)
  have "mk_circle a r = mk_circline ?A ?B ?C ?D"
    using *
    by (transfer, transfer, simp)
  hence "circline_set (mk_circle a r) - {h} = of_complex ` circline ?A ?B (Re ?D)"
    using classic_circline[of "mk_circle a r" ?A ?B ?C ?D] *
    by simp
  moreover
  have "circline ?A ?B (Re ?D) = circle a r"
    by (rule circline_circle[of ?A "Re ?D" "?B" "circline ?A ?B (Re ?D)" "a" "r*r" r], simp_all add: cmod_square r  0)
  moreover
  have "h  circline_set (mk_circle a r)"
    using inf_in_circline_set[of "mk_circle a r"] is_circle_mk_circle[of a r]
    by auto
  ultimately
  show ?thesis
    unfolding circle_def
    by simp
qed

text ‹The matrix of the circline representing line determined with two (not equal) complex points.›
definition mk_line_cmat :: "complex  complex  complex_mat" where
  [simp]: "mk_line_cmat z1 z2 =
    (if z1  z2 then
          let B = 𝗂 * (z2 - z1) in (0, B, cnj B, -cnj_mix B z1)
    else
          eye)"

lift_definition mk_line_clmat :: "complex  complex  circline_mat" is mk_line_cmat
  by (auto simp add: Let_def hermitean_def mat_adj_def mat_cnj_def  split: if_split_asm)

lift_definition mk_line :: "complex  complex  circline" is mk_line_clmat
  done

lemma circline_set_mk_line [simp]:
  assumes "z1  z2"
  shows "circline_set (mk_line z1 z2) - {h} = of_complex ` line z1 z2"
proof-
  let ?A = "0" and ?B = "𝗂*(z2 - z1)"
  let ?C = "cnj ?B" and ?D = "-cnj_mix ?B z1"
  have *: "(?A, ?B, ?C, ?D)  {H. hermitean H  H  mat_zero}"
    using assms
    by (simp add: hermitean_def mat_adj_def mat_cnj_def)
  have "mk_line z1 z2 = mk_circline ?A ?B ?C ?D"
    using * assms
    by (transfer, transfer, auto simp add: Let_def)
  hence "circline_set (mk_line z1 z2) - {h} = of_complex ` circline ?A ?B (Re ?D)"
    using classic_circline[of "mk_line z1 z2" ?A ?B ?C ?D] *
    by simp
  moreover
  have "circline ?A ?B (Re ?D) = line z1 z2"
    using z1  z2
    using circline_line'
    by simp
  ultimately
  show ?thesis
    by simp
qed

text ‹The set of points determined by a circline is always 
either an Euclidean circle or an Euclidean line. ›

text ‹Euclidean circle is determined by its center and radius.›
type_synonym euclidean_circle = "complex × real"

definition euclidean_circle_cmat :: "complex_mat  euclidean_circle" where
  [simp]: "euclidean_circle_cmat H = (let (A, B, C, D) = H in (-B/A, sqrt(Re ((B*C - A*D)/(A*A)))))"

lift_definition euclidean_circle_clmat :: "circline_mat  euclidean_circle" is euclidean_circle_cmat
  done

lift_definition euclidean_circle :: "circline  euclidean_circle" is euclidean_circle_clmat
proof transfer
  fix H1 H2
  assume hh: "hermitean H1  H1  mat_zero" "hermitean H2  H2  mat_zero"
  obtain A1 B1 C1 D1 where HH1: "H1 = (A1, B1, C1, D1)"
    by (cases "H1") auto
  obtain A2 B2 C2 D2 where HH2: "H2 = (A2, B2, C2, D2)"
    by (cases "H2") auto
  assume "circline_eq_cmat H1 H2"
  then obtain k where "k  0" and *: "A2 = cor k * A1" "B2 = cor k * B1" "C2 = cor k * C1" "D2 = cor k * D1"
    using HH1 HH2
    by auto
  have "(cor k * B1 * (cor k * C1) - cor k * A1 * (cor k * D1)) = (cor k)2 * (B1*C1 - A1*D1)"
    "(cor k * A1 * (cor k * A1)) = (cor k)2 * (A1*A1)"
    by (auto simp add: field_simps power2_eq_square)
  hence "(cor k * B1 * (cor k * C1) - cor k * A1 * (cor k * D1)) /
         (cor k * A1 * (cor k * A1)) = (B1*C1 - A1*D1) / (A1*A1)"
    using k  0
    by (simp add: power2_eq_square)
  thus "euclidean_circle_cmat H1 = euclidean_circle_cmat H2"
    using HH1 HH2 * hh
    by auto
qed

lemma classic_circle:
  assumes "is_circle H" and "(a, r) = euclidean_circle H" and "circline_type H  0"
  shows "circline_set H = of_complex ` circle a r"
proof-
  obtain A B C D where *: "H = mk_circline A B C D" "hermitean (A, B, C, D)" "(A, B, C, D)  mat_zero"
    using ex_mk_circline[of H]
    by auto
  have "is_real A" "is_real D" "C = cnj B"
    using * hermitean_elems
    by auto
  have "Re (A*D - B*C)  0"
    using ‹circline_type H  0 *
    by simp

  hence **: "Re A * Re D  (cmod B)2"
    using ‹is_real A ‹is_real D C = cnj B
    by (simp add: cmod_square)

  have "A  0"
    using ‹is_circle H * ‹is_real A
    by simp (transfer, transfer, simp)

  hence "Re A  0"
    using ‹is_real A
    by (metis complex_surj zero_complex.code)

  have ***: "h  circline_set H"
    using * inf_in_circline_set[of H] ‹is_circle H
    by simp

  let ?a = "-B/A"
  let ?r2 = "((cmod B)2 - Re A * Re D) / (Re A)2"
  let ?r = "sqrt ?r2"

  have "?a = a  ?r = r"
    using (a, r) = euclidean_circle H
    using * ‹is_real A ‹is_real D C = cnj B A  0
    apply simp
    apply transfer
    apply transfer
    apply simp
    apply (subst Re_divide_real)
    apply (simp_all add: cmod_square, simp add: power2_eq_square)
    done

  show ?thesis
    using * ** *** ‹Re A  0 ‹is_real A C = cnj B ?a = a  ?r = r
    using classic_circline[of H A B C D] assms circline_circle[of "Re A" "Re D" B "circline (Re A) B (Re D)" ?a ?r2 ?r]
    by (simp add: circle_def)
qed

text ‹Euclidean line is represented by two points.›
type_synonym euclidean_line = "complex × complex"

definition euclidean_line_cmat :: "complex_mat  euclidean_line" where
 [simp]: "euclidean_line_cmat H =
         (let (A, B, C, D) = H;
              z1 = -(D*B)/(2*B*C);
              z2 = z1 + 𝗂 * sgn (if arg B > 0 then -B else B)
           in (z1, z2))"

lift_definition euclidean_line_clmat :: "circline_mat  euclidean_line" is euclidean_line_cmat
  done

lift_definition euclidean_line :: "circline  complex × complex" is euclidean_line_clmat
proof transfer
  fix H1 H2
  assume hh: "hermitean H1  H1  mat_zero" "hermitean H2  H2  mat_zero"
  obtain A1 B1 C1 D1 where HH1: "H1 = (A1, B1, C1, D1)"
    by (cases "H1") auto
  obtain A2 B2 C2 D2 where HH2: "H2 = (A2, B2, C2, D2)"
    by (cases "H2") auto
  assume "circline_eq_cmat H1 H2"
  then obtain k where "k  0" and *: "A2 = cor k * A1" "B2 = cor k * B1" "C2 = cor k * C1" "D2 = cor k * D1"
    using HH1 HH2
    by auto
  have 1: "B1  0  0 < arg B1  ¬ 0 < arg (- B1)"
    using canon_ang_plus_pi1[of "arg B1"] arg_bounded[of B1]
    by (auto simp add: arg_uminus)
  have 2: "B1  0  ¬ 0 < arg B1  0 < arg (- B1)"
    using canon_ang_plus_pi2[of "arg B1"] arg_bounded[of B1]
    by (auto simp add: arg_uminus)

  show "euclidean_line_cmat H1 = euclidean_line_cmat H2"
    using HH1 HH2 * k  0
    by (cases "k > 0") (auto simp add: Let_def, simp_all add: norm_mult sgn_eq 1 2)
qed

lemma classic_line:
  assumes "is_line H" and "circline_type H < 0" and "(z1, z2) = euclidean_line H"
  shows "circline_set H - {h} = of_complex ` line z1 z2"
proof-
  obtain A B C D where *: "H = mk_circline A B C D" "hermitean (A, B, C, D)" "(A, B, C, D)  mat_zero"
    using ex_mk_circline[of H]
    by auto
  have "is_real A" "is_real D" "C = cnj B"
    using * hermitean_elems
    by auto
  have "Re A = 0"
    using ‹is_line H * ‹is_real A ‹is_real D C = cnj B
    by simp (transfer, transfer, simp)
  have "B  0"
    using ‹Re A = 0  ‹is_real A ‹is_real D C = cnj B * ‹circline_type H < 0
    using circline_type_mk_circline[of A B C D]
    by auto

  let ?z1 = "- cor (Re D) * B / (2 * B * cnj B)"
  let ?z2 = "?z1 + 𝗂 * sgn (if 0 < arg B then - B else B)"
  have "z1 = ?z1  z2 = ?z2"
    using (z1, z2) = euclidean_line H * ‹is_real A ‹is_real D C = cnj B
    by simp (transfer, transfer, simp add: Let_def)
  thus ?thesis
    using *
    using classic_circline[of H A B C D] circline_line[of "Re A" B "circline (Re A) B (Re D)" "Re D" ?z1 ?z2] ‹Re A = 0 B  0
    by simp
qed


(* ----------------------------------------------------------------- *)
subsection ‹Some special circlines›
(* ----------------------------------------------------------------- *)

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Unit circle›
(* ---------------------------------------------------------------------------- *)

definition unit_circle_cmat :: complex_mat where
  [simp]: "unit_circle_cmat =  (1, 0, 0, -1)"
lift_definition unit_circle_clmat :: circline_mat is unit_circle_cmat
  by (simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition unit_circle :: circline is unit_circle_clmat
  done

lemma on_circline_cmat_cvec_unit:
  shows "on_circline_cmat_cvec unit_circle_cmat (z1, z2)  
         z1 * cnj z1 = z2 * cnj z2"
  by (simp add: vec_cnj_def field_simps)

lemma
  one_on_unit_circle [simp]: "on_circline unit_circle 1h"  and
  ii_on_unit_circle [simp]: "on_circline unit_circle iih" and
  not_zero_on_unit_circle [simp]: "¬ on_circline unit_circle 0h"
  by (transfer, transfer, simp add: vec_cnj_def)+

lemma  
  one_in_unit_circle_set [simp]: "1h  circline_set unit_circle" and
  ii_in_unit_circle_set [simp]: "iih  circline_set unit_circle" and
  zero_in_unit_circle_set [simp]: "0h  circline_set unit_circle"
  unfolding circline_set_def
  by simp_all

lemma is_circle_unit_circle [simp]:
  shows "is_circle unit_circle"
  by (transfer, transfer, simp)

lemma not_inf_on_unit_circle' [simp]:
  shows "¬ on_circline unit_circle h"
  using is_circle_unit_circle inf_on_circline
  by blast

lemma not_inf_on_unit_circle'' [simp]:
  shows "h  circline_set unit_circle"
  by (simp add: inf_in_circline_set)

lemma euclidean_circle_unit_circle [simp]:
  shows "euclidean_circle unit_circle = (0, 1)"
  by (transfer, transfer, simp)

lemma circline_type_unit_circle [simp]:
  shows "circline_type unit_circle = -1"
  by (transfer, transfer, simp)

lemma on_circline_unit_circle [simp]:
  shows "on_circline unit_circle (of_complex z)  cmod z = 1"
  by (transfer, transfer, simp add: vec_cnj_def mult.commute)

lemma circline_set_unit_circle [simp]:
  shows "circline_set unit_circle = of_complex ` {z. cmod z = 1}"
proof-
  show ?thesis
  proof safe
    fix x
    assume "x  circline_set unit_circle"
    then obtain x' where "x = of_complex x'"
      using inf_or_of_complex[of x]
      by auto
    thus "x  of_complex ` {z. cmod z = 1}"
      using x  circline_set unit_circle›
      unfolding circline_set_def              
      by auto
  next
    fix x
    assume "cmod x = 1"
    thus "of_complex x  circline_set unit_circle"
      unfolding circline_set_def
      by auto
  qed
qed

lemma circline_set_unit_circle_I [simp]:
  assumes "cmod z = 1"
  shows "of_complex z  circline_set unit_circle"
  using assms
  unfolding circline_set_unit_circle
  by simp

lemma inversion_unit_circle [simp]:
  assumes "on_circline unit_circle x"
  shows "inversion x = x"
proof-
  obtain x' where "x = of_complex x'" "x'  0"
    using inf_or_of_complex[of x]
    using assms
    by force
  moreover
  hence "x' * cnj x' = 1"
    using assms
    using circline_set_unit_circle
    unfolding circline_set_def
    by auto
  hence "1 / cnj x' = x'"
    using x'  0
    by (simp add: field_simps)
  ultimately
  show ?thesis
    using assms
    unfolding inversion_def
    by simp
qed

lemma inversion_id_iff_on_unit_circle: 
  shows "inversion a = a  on_circline unit_circle a"
  using inversion_id_iff[of a] inf_or_of_complex[of a]
  by auto

lemma on_unit_circle_conjugate [simp]:
  shows "on_circline unit_circle (conjugate z)  on_circline unit_circle z"
  by (transfer, transfer, auto simp add: vec_cnj_def field_simps)

lemma conjugate_unit_circle_set [simp]:
  shows "conjugate ` (circline_set unit_circle) = circline_set unit_circle"
  unfolding circline_set_def
  by (auto simp add: image_iff, rule_tac x="conjugate x" in exI, simp)

(* ---------------------------------------------------------------------------- *)
subsubsection ‹x-axis›
(* ---------------------------------------------------------------------------- *)

definition x_axis_cmat :: complex_mat where
  [simp]: "x_axis_cmat =  (0, 𝗂, -𝗂, 0)"
lift_definition x_axis_clmat :: circline_mat is x_axis_cmat
  by (simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition x_axis :: circline is x_axis_clmat
  done

lemma special_points_on_x_axis' [simp]:
  shows "on_circline x_axis 0h" and "on_circline x_axis 1h" and "on_circline x_axis h"
  by (transfer, transfer, simp add: vec_cnj_def)+

lemma special_points_on_x_axis'' [simp]:
  shows "0h  circline_set x_axis" and "1h  circline_set x_axis" and "h  circline_set x_axis"
  unfolding circline_set_def
  by auto

lemma is_line_x_axis [simp]:
  shows "is_line x_axis"
  by (transfer, transfer, simp)

lemma circline_type_x_axis [simp]:
  shows "circline_type x_axis = -1"
  by (transfer, transfer, simp)

lemma on_circline_x_axis:
  shows "on_circline x_axis z  ( c. is_real c  z = of_complex c)  z = h"
proof safe
  fix z c
  assume "is_real c"
  thus "on_circline x_axis (of_complex c)"
  proof (transfer, transfer)
    fix c
    assume "is_real c"
    thus "on_circline_cmat_cvec x_axis_cmat (of_complex_cvec c)"
      using eq_cnj_iff_real[of c]
      by (simp add: vec_cnj_def)
  qed
next
  fix z
  assume "on_circline x_axis z" "z  h"
  thus "c. is_real c  z = of_complex c"
  proof (transfer, transfer, safe)
    fix a b
    assume "(a, b)  vec_zero"
      "on_circline_cmat_cvec x_axis_cmat (a, b)"
      "¬ (a, b) v v"
    hence "b  0" "cnj a * b = cnj b * a" using inf_cvec_z2_zero_iff
      by (auto simp add: vec_cnj_def)
    thus "c. is_real c  (a, b) v of_complex_cvec c"
      apply (rule_tac x="a/b" in exI)
      apply (auto simp add: is_real_div field_simps)
      apply (rule_tac x="1/b" in exI, simp)
      done
  qed
next
  show "on_circline x_axis h"
    by auto
qed

lemma on_circline_x_axis_I [simp]:
  assumes "is_real z"
  shows "on_circline x_axis (of_complex z)"
  using assms
  unfolding on_circline_x_axis
  by auto

lemma circline_set_x_axis:
  shows "circline_set x_axis = of_complex ` {x. is_real x}  {h}"
  using on_circline_x_axis
  unfolding circline_set_def
  by auto

lemma circline_set_x_axis_I:
  assumes "is_real z"
  shows "of_complex z  circline_set x_axis"
  using assms
  unfolding circline_set_x_axis
  by auto

lemma circline_equation_x_axis:
  shows "of_complex z  circline_set x_axis  z = cnj z"
  unfolding circline_set_x_axis
proof auto
  fix x
  assume "of_complex z = of_complex x" "is_real x"
  hence "z = x"
    using of_complex_inj[of z x]
    by simp
  thus "z = cnj z"
    using eq_cnj_iff_real[of z] ‹is_real x
    by auto
next
  assume "z = cnj z"
  thus "of_complex z  of_complex ` {x. is_real x} "
    using eq_cnj_iff_real[of z]
    by auto
qed

text ‹Positive and negative part of x-axis›

definition positive_x_axis where
  "positive_x_axis = {z. z  circline_set x_axis  z  h  Re (to_complex z) > 0}"

definition negative_x_axis where
  "negative_x_axis = {z. z  circline_set x_axis  z  h  Re (to_complex z) < 0}"

lemma circline_set_positive_x_axis_I [simp]:
  assumes "is_real z" and "Re z > 0"
  shows "of_complex z  positive_x_axis"
  using assms
  unfolding positive_x_axis_def
  by simp

lemma circline_set_negative_x_axis_I [simp]:
  assumes "is_real z" and "Re z < 0"
  shows "of_complex z  negative_x_axis"
  using assms
  unfolding negative_x_axis_def
  by simp

(* ---------------------------------------------------------------------------- *)
subsubsection ‹y-axis›
(* ---------------------------------------------------------------------------- *)

definition y_axis_cmat :: complex_mat where
  [simp]: "y_axis_cmat = (0, 1, 1, 0)"
lift_definition y_axis_clmat :: circline_mat is y_axis_cmat
  by (simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition y_axis :: circline is y_axis_clmat
  done

lemma special_points_on_y_axis' [simp]:
  shows "on_circline y_axis 0h" and "on_circline y_axis iih" and "on_circline y_axis h"
  by (transfer, transfer, simp add: vec_cnj_def)+

lemma special_points_on_y_axis'' [simp]:
  shows "0h  circline_set y_axis" and "iih  circline_set y_axis" and "h  circline_set y_axis"
  unfolding circline_set_def
  by auto

lemma on_circline_y_axis: 
  shows "on_circline y_axis z  ( c. is_imag c  z = of_complex c)  z = h"
proof safe
  fix z c
  assume "is_imag c"
  thus "on_circline y_axis (of_complex c)"                                 
  proof (transfer, transfer)
    fix c                                                       
    assume "is_imag c"
    thus "on_circline_cmat_cvec y_axis_cmat (of_complex_cvec c)"
      using eq_minus_cnj_iff_imag[of c]
      by (simp add: vec_cnj_def)
  qed
next
  fix z
  assume "on_circline y_axis z" "z  h"
  thus "c. is_imag c  z = of_complex c"
  proof (transfer, transfer, safe)
    fix a b
    assume "(a, b)  vec_zero"
      "on_circline_cmat_cvec y_axis_cmat (a, b)"
      "¬ (a, b) v v"
    hence "b  0" "cnj a * b + cnj b * a = 0"
      using inf_cvec_z2_zero_iff
      by (blast, smt add.left_neutral add_cancel_right_right mult.commute mult.left_neutral mult_not_zero on_circline_cmat_cvec_circline_equation y_axis_cmat_def)
    thus "c. is_imag c  (a, b) v of_complex_cvec c"
      using eq_minus_cnj_iff_imag[of "a / b"]
      apply (rule_tac x="a/b" in exI)
      apply (auto simp add: field_simps)
      apply (rule_tac x="1/b" in exI, simp)
      using add_eq_0_iff apply blast
      apply (rule_tac x="1/b" in exI, simp)
      done
  qed
next
  show "on_circline y_axis h"
    by simp
qed

lemma on_circline_y_axis_I [simp]:
  assumes "is_imag z"
  shows "on_circline y_axis (of_complex z)"
  using assms
  unfolding on_circline_y_axis
  by auto

lemma circline_set_y_axis:
  shows "circline_set y_axis = of_complex ` {x. is_imag x}  {h}"
  using on_circline_y_axis
  unfolding circline_set_def
  by auto

lemma circline_set_y_axis_I:
  assumes "is_imag z"
  shows "of_complex z  circline_set y_axis"
  using assms
  unfolding circline_set_y_axis
  by auto

text ‹Positive and negative part of y-axis›

definition positive_y_axis where
  "positive_y_axis = {z. z  circline_set y_axis  z  h  Im (to_complex z) > 0}"

definition negative_y_axis where
  "negative_y_axis = {z. z  circline_set y_axis  z  h  Im (to_complex z) < 0}"

lemma circline_set_positive_y_axis_I [simp]:
  assumes "is_imag z" and "Im z > 0"
  shows "of_complex z  positive_y_axis"
  using assms
  unfolding positive_y_axis_def
  by simp

lemma circline_set_negative_y_axis_I [simp]:
  assumes "is_imag z" and "Im z < 0"
  shows "of_complex z  negative_y_axis"
  using assms
  unfolding negative_y_axis_def
  by simp

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Point zero as a circline›
(* ---------------------------------------------------------------------------- *)

definition circline_point_0_cmat :: complex_mat where
  [simp]: "circline_point_0_cmat =  (1, 0, 0, 0)"
lift_definition circline_point_0_clmat :: circline_mat is circline_point_0_cmat
  by (simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition circline_point_0 :: circline is circline_point_0_clmat
  done

lemma circline_type_circline_point_0 [simp]:
  shows "circline_type circline_point_0 = 0"
  by (transfer, transfer, simp)

lemma zero_in_circline_point_0 [simp]:
  shows "0h  circline_set circline_point_0"
  unfolding circline_set_def
  by auto (transfer, transfer, simp add: vec_cnj_def)+

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Imaginary unit circle›
(* ---------------------------------------------------------------------------- *)

definition imag_unit_circle_cmat :: complex_mat where
  [simp]: "imag_unit_circle_cmat =  (1, 0, 0, 1)"
lift_definition imag_unit_circle_clmat :: circline_mat is imag_unit_circle_cmat
  by (simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition imag_unit_circle :: circline is imag_unit_circle_clmat
  done

lemma circline_type_imag_unit_circle [simp]:
  shows "circline_type imag_unit_circle = 1"
  by (transfer, transfer, simp)

(* ----------------------------------------------------------------- *)
subsection ‹Intersection of circlines›
(* ----------------------------------------------------------------- *)

definition circline_intersection :: "circline  circline  complex_homo set" where
  "circline_intersection H1 H2 = {z. on_circline H1 z  on_circline H2 z}"

lemma circline_equation_cancel_z2:
  assumes "circline_equation A B C D z1 z2 " and "z2  0"
  shows "circline_equation A B C D (z1/z2) 1"
  using assms
  by (simp add: field_simps)

lemma circline_equation_quadratic_equation:
  assumes "circline_equation A B (cnj B) D z 1" and 
          "Re z = x" and "Im z = y" and "Re B = bx" and "Im B = by"
  shows "A*x2 + A*y2 + 2*bx*x + 2*by*y + D = 0"
  using assms
proof-
  have "z = x + 𝗂*y" "B = bx + 𝗂*by"
    using assms complex_eq
    by auto
  thus ?thesis
    using assms
    by (simp add: field_simps power2_eq_square)
qed

lemma circline_intersection_symetry:
  shows "circline_intersection H1 H2 = circline_intersection H2 H1"
  unfolding circline_intersection_def
  by auto

(* ----------------------------------------------------------------- *)
subsection ‹Möbius action on circlines›
(* ----------------------------------------------------------------- *)

definition moebius_circline_cmat_cmat :: "complex_mat  complex_mat  complex_mat" where
  [simp]: "moebius_circline_cmat_cmat M H = congruence (mat_inv M) H"

lift_definition moebius_circline_mmat_clmat :: "moebius_mat  circline_mat  circline_mat" is moebius_circline_cmat_cmat
  using mat_det_inv congruence_nonzero hermitean_congruence
  by simp

lift_definition moebius_circline :: "moebius  circline  circline" is moebius_circline_mmat_clmat
proof transfer
  fix M M' H H'
  assume "moebius_cmat_eq M M'" "circline_eq_cmat H H'"
  thus "circline_eq_cmat (moebius_circline_cmat_cmat M H) (moebius_circline_cmat_cmat M' H')"
    by (auto simp add: mat_inv_mult_sm) (rule_tac x="ka / Re (k * cnj k)" in exI, auto simp add: complex_mult_cnj_cmod power2_eq_square)
qed

lemma moebius_preserve_circline_type [simp]:                                
  shows "circline_type (moebius_circline M H) = circline_type H"
proof (transfer, transfer)
  fix M H :: complex_mat
  assume "mat_det M  0" "hermitean H  H  mat_zero"
  thus "circline_type_cmat (moebius_circline_cmat_cmat M H) = circline_type_cmat H"
    using Re_det_sgn_congruence[of "mat_inv M" "H"] mat_det_inv[of "M"]
    by (simp del: congruence_def)
qed

text ‹The central lemma in this section connects the action of Möbius transformations on points and
on circlines.›

lemma moebius_circline:
  shows "{z. on_circline (moebius_circline M H) z} =
         moebius_pt M ` {z. on_circline H z}"
proof safe
  fix z
  assume "on_circline H z"
  thus "on_circline (moebius_circline M H) (moebius_pt M z)"
  proof (transfer, transfer)
    fix z :: complex_vec and M H :: complex_mat
    assume hh: "hermitean H  H  mat_zero" "z  vec_zero" "mat_det M  0"
    let ?z = "M *mv z"
    let ?H = "mat_adj (mat_inv M) *mm H *mm (mat_inv M)"
    assume *: "on_circline_cmat_cvec H z"
    hence "quad_form z H = 0"
      by simp
    hence "quad_form ?z ?H = 0"
      using quad_form_congruence[of M z H] hh
      by simp
    thus "on_circline_cmat_cvec (moebius_circline_cmat_cmat M H) (moebius_pt_cmat_cvec M z)"
      by simp
  qed
next
  fix z
  assume "on_circline (moebius_circline M H) z"
  hence " z'. z = moebius_pt M z'  on_circline H z'"
  proof (transfer, transfer)
    fix z :: complex_vec and M H :: complex_mat
    assume hh: "hermitean H  H  mat_zero" "z  vec_zero" "mat_det M  0"
    let ?iM = "mat_inv M"
    let ?z' = "?iM *mv z"
    assume *: "on_circline_cmat_cvec (moebius_circline_cmat_cmat M H) z"
    have "?z'  vec_zero"
      using hh
      using mat_det_inv mult_mv_nonzero
      by auto
    moreover
    have "z v moebius_pt_cmat_cvec M ?z'"
      using hh eye_mv_l mat_inv_r
      by simp
    moreover
    have "M *mv (?iM *mv z) = z"
      using hh eye_mv_l mat_inv_r
      by auto
    hence "on_circline_cmat_cvec H ?z'"
      using hh *
      using quad_form_congruence[of M "?iM *mv z" H, symmetric]
      unfolding moebius_circline_cmat_cmat_def
      unfolding on_circline_cmat_cvec_def
      by simp
    ultimately
    show "z'{v. v  vec_zero}. z v moebius_pt_cmat_cvec M z'  on_circline_cmat_cvec H z'"
      by blast
  qed
  thus "z  moebius_pt M ` {z. on_circline H z}"
    by auto
qed

lemma on_circline_moebius_circline_I [simp]:
  assumes "on_circline H z"
  shows "on_circline (moebius_circline M H) (moebius_pt M z)"
  using assms moebius_circline
  by fastforce

lemma circline_set_moebius_circline [simp]:
  shows "circline_set (moebius_circline M H) = moebius_pt M ` circline_set H"
  using moebius_circline[of M H]
  unfolding circline_set_def
  by auto

lemma circline_set_moebius_circline_I [simp]:
  assumes "z  circline_set H"
  shows "moebius_pt M z  circline_set (moebius_circline M H)"
  using assms
  by simp

lemma circline_set_moebius_circline_E:
  assumes "moebius_pt M z  circline_set (moebius_circline M H)"
  shows "z  circline_set H"
  using assms
  using moebius_pt_eq_I[of M z]
  by auto

lemma circline_set_moebius_circline_iff [simp]:
  shows "moebius_pt M z  circline_set (moebius_circline M H)  
         z  circline_set H"
  using moebius_pt_eq_I[of M z]
  by auto

lemma inj_moebius_circline:
  shows "inj (moebius_circline M)"
unfolding inj_on_def
proof (safe)
  fix H H'
  assume "moebius_circline M H = moebius_circline M H'"
  thus "H = H'"
  proof (transfer, transfer)
    fix M H H' :: complex_mat
    assume hh: "mat_det M  0"
    let ?iM = "mat_inv M"
    assume "circline_eq_cmat (moebius_circline_cmat_cmat M H) (moebius_circline_cmat_cmat M H')"
    then obtain k where "congruence ?iM H' = congruence ?iM (cor k *sm H)" "k  0"
      by auto
    thus "circline_eq_cmat H H'"
      using hh inj_congruence[of ?iM H' "cor k *sm H"] mat_det_inv[of M]
      by auto
  qed
qed

lemma moebius_circline_eq_I:
  assumes "moebius_circline M H1 = moebius_circline M H2"
  shows "H1 = H2"
  using assms inj_moebius_circline[of M]
  unfolding inj_on_def
  by blast

lemma moebius_circline_neq_I [simp]:
  assumes "H1  H2"
  shows "moebius_circline M H1  moebius_circline M H2"
  using assms inj_moebius_circline[of M]
  unfolding inj_on_def
  by blast

(* ---------------------------------------------------------------------------- *)
subsubsection ‹Group properties of Möbius action on ciclines›
(* ---------------------------------------------------------------------------- *)

text ‹Möbius actions on circlines have similar properties as Möbius actions on points.›

lemma moebius_circline_id [simp]:
  shows "moebius_circline id_moebius H = H"
  by (transfer, transfer) (simp add: mat_adj_def mat_cnj_def, rule_tac x=1 in exI, auto)

lemma moebius_circline_comp [simp]:
  shows "moebius_circline (moebius_comp M1 M2) H = moebius_circline M1 (moebius_circline M2 H)"
  by (transfer, transfer) (simp add: mat_inv_mult_mm, rule_tac x=1 in exI, simp add: mult_mm_assoc)

lemma moebius_circline_comp_inv_left [simp]:
  shows "moebius_circline (moebius_inv M) (moebius_circline M H) = H"
  by (subst moebius_circline_comp[symmetric], simp)

lemma moebius_circline_comp_inv_right [simp]:
  shows "moebius_circline M (moebius_circline (moebius_inv M) H) = H"
  by (subst moebius_circline_comp[symmetric], simp)

(* ----------------------------------------------------------------- *)
subsection ‹Action of Euclidean similarities on circlines›
(* ----------------------------------------------------------------- *)

lemma moebius_similarity_lines_to_lines [simp]:
  assumes "a  0"
  shows "h  circline_set (moebius_circline (moebius_similarity a b) H)  
         h  circline_set H"
  using assms       
  by (metis circline_set_moebius_circline_iff moebius_similarity_inf)

lemma moebius_similarity_lines_to_lines':
  assumes "a  0"
  shows "on_circline (moebius_circline (moebius_similarity a b) H) h 
         h  circline_set H"
  using moebius_similarity_lines_to_lines assms
  unfolding circline_set_def
  by simp

(* ----------------------------------------------------------------- *)
subsection ‹Conjugation, recpiprocation and inversion of circlines›
(* ----------------------------------------------------------------- *)

text ‹Conjugation of circlines›
definition conjugate_circline_cmat :: "complex_mat  complex_mat" where
 [simp]: "conjugate_circline_cmat = mat_cnj"
lift_definition conjugate_circline_clmat :: "circline_mat  circline_mat" is conjugate_circline_cmat
  by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition conjugate_circline :: "circline  circline" is conjugate_circline_clmat
  by transfer (metis circline_eq_cmat_def conjugate_circline_cmat_def hermitean_transpose mat_t_mult_sm)

lemma conjugate_circline_set':
  shows "conjugate ` circline_set H  circline_set (conjugate_circline H)"
proof (safe)
  fix z
  assume "z  circline_set H"
  thus "conjugate z  circline_set (conjugate_circline H)"
    unfolding circline_set_def
    apply simp
    apply (transfer, transfer)
    unfolding on_circline_cmat_cvec_def conjugate_cvec_def conjugate_circline_cmat_def
    apply (subst quad_form_vec_cnj_mat_cnj, simp_all)
    done
qed

lemma conjugate_conjugate_circline [simp]:
  shows "conjugate_circline (conjugate_circline H) = H"
  by (transfer, transfer, force)

lemma circline_set_conjugate_circline [simp]:
  shows "circline_set (conjugate_circline H) = conjugate ` circline_set H" (is "?lhs = ?rhs")
proof (safe)
  fix z
  assume "z  ?lhs"
  show "z  ?rhs"
  proof
    show "z = conjugate (conjugate z)"
      by simp
  next
    show "conjugate z  circline_set H"
      using z  circline_set (conjugate_circline H)
      using conjugate_circline_set'[of "conjugate_circline H"]
      by auto
  qed
next
  fix z
  assume "z  circline_set H"
  thus "conjugate z  circline_set (conjugate_circline H)"
    using conjugate_circline_set'[of H]
    by auto
qed

lemma on_circline_conjugate_circline [simp]: 
  shows "on_circline (conjugate_circline H) z  on_circline H (conjugate z)"
  using circline_set_conjugate_circline[of H]
  unfolding circline_set_def
  by force

text ‹Inversion of circlines›

definition circline_inversion_cmat :: "complex_mat  complex_mat" where
  [simp]:  "circline_inversion_cmat H = (let (A, B, C, D) = H in (D, B, C, A))"
lift_definition circline_inversion_clmat :: "circline_mat  circline_mat" is circline_inversion_cmat
  by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition circline_inversion :: "circline  circline" is circline_inversion_clmat
  by transfer auto

lemma on_circline_circline_inversion [simp]:
  shows "on_circline (circline_inversion H) z  on_circline H (reciprocal (conjugate z))"
  by (transfer, transfer, auto simp add: vec_cnj_def field_simps)

lemma circline_set_circline_inversion [simp]:
  shows "circline_set (circline_inversion H) = inversion ` circline_set H"
  unfolding circline_set_def inversion_def
  by (force simp add: comp_def image_iff)

text ‹Reciprocal of circlines›

definition circline_reciprocal :: "circline  circline" where
  "circline_reciprocal = conjugate_circline  circline_inversion"

lemma circline_set_circline_reciprocal:
  shows "circline_set (circline_reciprocal H) = reciprocal ` circline_set H"
  unfolding circline_reciprocal_def comp_def
  by (auto simp add: inversion_def image_iff)

text ‹Rotation of circlines›

lemma rotation_pi_2_y_axis [simp]:
  shows "moebius_circline (moebius_rotation (pi/2)) y_axis = x_axis"
  unfolding moebius_rotation_def moebius_similarity_def
  by (transfer, transfer, simp add: mat_adj_def mat_cnj_def)

lemma rotation_minus_pi_2_y_axis [simp]:
  shows "moebius_circline (moebius_rotation (-pi/2)) y_axis = x_axis"
  unfolding moebius_rotation_def moebius_similarity_def
  by (transfer, transfer, simp add: mat_adj_def mat_cnj_def, rule_tac x="-1" in exI, simp)

lemma rotation_minus_pi_2_x_axis [simp]:
  shows "moebius_circline (moebius_rotation (-pi/2)) x_axis = y_axis"
  unfolding moebius_rotation_def moebius_similarity_def
  by (transfer, transfer, simp add: mat_adj_def mat_cnj_def)

lemma rotation_pi_2_x_axis [simp]:
  shows "moebius_circline (moebius_rotation (pi/2)) x_axis = y_axis"
  unfolding moebius_rotation_def moebius_similarity_def
  by (transfer, transfer, simp add: mat_adj_def mat_cnj_def, rule_tac x="-1" in exI, simp)

lemma rotation_minus_pi_2_positive_y_axis [simp]:
  shows "(moebius_pt (moebius_rotation (-pi/2))) ` positive_y_axis = positive_x_axis"
proof safe
  fix y
  assume y: "y  positive_y_axis"
  have *: "Re (a * 𝗂 / b) < 0  Im (a / b) > 0" for a b
    by (subst times_divide_eq_left [symmetric], subst mult.commute, subst Re_i_times) auto
  from y * show "moebius_pt (moebius_rotation (-pi/2)) y  positive_x_axis"
    unfolding positive_y_axis_def positive_x_axis_def circline_set_def
    unfolding moebius_rotation_def moebius_similarity_def
    apply simp
    apply transfer
    apply transfer
    apply (auto simp add: vec_cnj_def field_simps add_eq_0_iff)
    done
next
  fix x
  assume x: "x  positive_x_axis"
  let ?y = "moebius_pt (moebius_rotation (pi/2)) x"
  have *: "Im (a * 𝗂 / b) > 0  Re (a / b) > 0" for a b
    by (subst times_divide_eq_left [symmetric], subst mult.commute, subst Im_i_times) auto
  hence "?y  positive_y_axis"
    using x  positive_x_axis›
    unfolding positive_x_axis_def positive_y_axis_def
    unfolding moebius_rotation_def moebius_similarity_def
    unfolding circline_set_def
    apply simp
    apply transfer
    apply transfer
    apply (auto simp add: vec_cnj_def field_simps add_eq_0_iff)
    done
  thus "x  moebius_pt (moebius_rotation (-pi/2)) ` positive_y_axis"
    by (auto simp add: image_iff) (rule_tac x="?y" in bexI, simp_all)
qed

(* ----------------------------------------------------------------- *)
subsection ‹Circline uniqueness›
(* ----------------------------------------------------------------- *)

(* ----------------------------------------------------------------- *)
subsubsection ‹Zero type circline uniqueness›
(* ----------------------------------------------------------------- *)

lemma unique_circline_type_zero_0':
  shows "(circline_type circline_point_0 = 0  0h  circline_set circline_point_0) 
         ( H. circline_type H = 0  0h  circline_set H  H = circline_point_0)"
unfolding circline_set_def
proof (safe)
  show "circline_type circline_point_0 = 0"
    by (transfer, transfer, simp)
next
  show "on_circline circline_point_0 0h"
    using circline_set_def zero_in_circline_point_0
    by auto
next
  fix H
  assume "circline_type H = 0" "on_circline H 0h"
  thus "H = circline_point_0"
  proof (transfer, transfer)
    fix H :: complex_mat
    assume hh: "hermitean H  H  mat_zero"
    obtain A B C D where HH: "H = (A, B, C, D)"
      by (cases "H") auto
    hence *: "C = cnj B" "is_real A"
      using hh hermitean_elems[of A B C D]
      by auto
    assume "circline_type_cmat H = 0" "on_circline_cmat_cvec H 0v"
    thus "circline_eq_cmat H circline_point_0_cmat"
      using HH hh *
      by (simp add: Let_def vec_cnj_def sgn_minus sgn_mult sgn_zero_iff)
         (rule_tac x="1/Re A" in exI, cases A, cases B, simp add: Complex_eq sgn_zero_iff)
  qed
qed

lemma unique_circline_type_zero_0:
  shows "∃! H. circline_type H = 0  0h  circline_set H"
  using unique_circline_type_zero_0'
  by blast

lemma unique_circline_type_zero:
  shows "∃! H. circline_type H = 0  z  circline_set H"
proof-
  obtain M where ++: "moebius_pt M z = 0h"
    using ex_moebius_1[of z]
    by auto
  have +++: "z = moebius_pt (moebius_inv M) 0h"
    by (subst ++[symmetric]) simp
  then obtain H0 where *: "circline_type H0 = 0  0h  circline_set H0" and
    **: " H'. circline_type H' = 0  0h  circline_set H'  H' = H0"
    using unique_circline_type_zero_0
    by auto
  let ?H' = "moebius_circline (moebius_inv M) H0"
  show ?thesis
    unfolding Ex1_def
    using * +++
  proof (rule_tac x="?H'" in exI, simp, safe)
    fix H'
    assume "circline_type H' = 0" "moebius_pt (moebius_inv M) 0h  circline_set H'"
    hence "0h  circline_set (moebius_circline M H')"
      using ++ +++
      by force
    hence "moebius_circline M H' = H0"
      using **[rule_format, of "moebius_circline M H'"]
      using ‹circline_type H' = 0
      by simp
    thus "H' = moebius_circline (moebius_inv M) H0"
      by auto
  qed
qed

(* ----------------------------------------------------------------- *)
subsubsection ‹Negative type circline uniqueness›
(* ----------------------------------------------------------------- *)

lemma unique_circline_01inf':
  shows "0h  circline_set x_axis  1h  circline_set x_axis  h  circline_set x_axis 
        ( H. 0h  circline_set H  1h  circline_set H  h  circline_set H   H = x_axis)"
proof safe
  fix H
  assume "0h  circline_set H"  "1h  circline_set H" "h  circline_set H"
  thus "H = x_axis"
    unfolding circline_set_def
    apply simp
  proof (transfer, transfer)
    fix H
    assume hh: "hermitean H  H  mat_zero"
    obtain A B C D where HH: "H = (A, B, C, D)"
      by (cases H) auto
    have *: "C = cnj B" "A = 0  D = 0  B  0"
      using hermitean_elems[of A B C D] hh HH
      by auto
    obtain Bx By where "B = Complex Bx By"
      by (cases B) auto
    assume "on_circline_cmat_cvec H 0v" "on_circline_cmat_cvec H 1v" "on_circline_cmat_cvec H v"
    thus "circline_eq_cmat H x_axis_cmat"
      using * HH C = cnj B B = Complex Bx By
      by (simp add: Let_def vec_cnj_def Complex_eq) (rule_tac x="1/By" in exI, auto)
  qed
qed simp_all

lemma unique_circline_set:
  assumes "A  B" and "A  C" and "B  C"
  shows "∃! H. A  circline_set H  B  circline_set H  C  circline_set H"
proof-
  let ?P = "λ A B C. A  B  A  C  B  C  (∃! H. A  circline_set H  B  circline_set H  C  circline_set H)"
  have "?P A B C"
  proof (rule wlog_moebius_01inf[of ?P])
    fix M a b c
    let ?M = "moebius_pt M"
    assume "?P a b c"
    show "?P (?M a) (?M b) (?M c)"
    proof
      assume "?M a  ?M b  ?M a  ?M c  ?M b  ?M c"
      hence "a  b" "b  c" "a  c"
        by auto
      hence "∃!H. a  circline_set H  b  circline_set H  c  circline_set H"
        using ?P a b c
        by simp
      then obtain H where
        *: "a  circline_set H  b  circline_set H  c  circline_set H" and
        **: "H'. a  circline_set H'  b  circline_set H'  c  circline_set H'  H' = H"
        unfolding Ex1_def
        by auto
      let ?H' = "moebius_circline M H"
      show "∃! H. ?M a  circline_set H  moebius_pt M b  circline_set H  moebius_pt M c  circline_set H"
        unfolding Ex1_def
      proof (rule_tac x="?H'" in exI, rule)
        show "?M a  circline_set ?H'  ?M b  circline_set ?H'  ?M c  circline_set ?H'"
          using * 
          by auto
      next
        show "H'. ?M a  circline_set H'  ?M b  circline_set H'  ?M c  circline_set H'  H' = ?H'"
        proof (safe)
          fix H'
          let ?iH' = "moebius_circline (moebius_inv M) H'"
          assume "?M a  circline_set H'" "?M b  circline_set H'" "?M c  circline_set H'"
          hence "a  circline_set ?iH'  b  circline_set ?iH'  c  circline_set ?iH'"
            by simp
          hence "H = ?iH'"
            using **
            by blast
          thus "H' = moebius_circline M H"
            by simp
        qed
      qed
    qed
  next
    show "?P 0h 1h h"
      using unique_circline_01inf'
      unfolding Ex1_def
      by (safe, rule_tac x="x_axis" in exI) auto
  qed fact+
  thus ?thesis
    using assms
    by simp
qed

lemma zero_one_inf_x_axis [simp]:
  assumes "0h  circline_set H" and "1h  circline_set H" and "h  circline_set H"
  shows "H = x_axis"
  using assms unique_circline_set[of "0h" "1h" "h"]
  by auto

(* ----------------------------------------------------------------- *)
subsection ‹Circline set cardinality›
(* ----------------------------------------------------------------- *)

(* ----------------------------------------------------------------- *)
subsubsection ‹Diagonal circlines›
(* ----------------------------------------------------------------- *)

definition is_diag_circline_cmat :: "complex_mat  bool" where
 [simp]: "is_diag_circline_cmat H = (let (A, B, C, D) = H in B = 0  C = 0)"
lift_definition is_diag_circline_clmat :: "circline_mat  bool" is is_diag_circline_cmat
  done
lift_definition circline_diag :: "circline  bool" is is_diag_circline_clmat
  by transfer auto

lemma circline_diagonalize:
  shows " M H'. moebius_circline M H = H'  circline_diag H'"
proof (transfer, transfer)
  fix H
  assume hh: "hermitean H  H  mat_zero"
  obtain A B C D where HH: "H = (A, B, C, D)"
    by (cases "H") auto
  hence HH_elems: "is_real A" "is_real D" "C = cnj B"
    using hermitean_elems[of A B C D] hh
    by auto
  obtain M k1 k2 where *: "mat_det M  0" "unitary M" "congruence M H = (k1, 0, 0, k2)" "is_real k1" "is_real k2"
    using hermitean_diagonizable[of H] hh
    by auto
  have "k1  0  k2  0"
    using ‹congruence M H = (k1, 0, 0, k2) hh congruence_nonzero[of H M] ‹mat_det M  0
    by auto
  let ?M' = "mat_inv M"
  let ?H' = "(k1, 0, 0, k2)"
  have "circline_eq_cmat (moebius_circline_cmat_cmat ?M' H) ?H'  is_diag_circline_cmat ?H'"
    using *
    by force
  moreover
  have "?H'  hermitean_nonzero"
    using * k1  0  k2  0 eq_cnj_iff_real[of k1] eq_cnj_iff_real[of k2]
    by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
  moreover
  have "mat_det ?M'  0"
    using * mat_det_inv[of M]
    by auto
  ultimately
  show "M{M. mat_det M  0}.
            H'hermitean_nonzero.
               circline_eq_cmat (moebius_circline_cmat_cmat M H) H'  is_diag_circline_cmat H'"
    by blast
qed

lemma wlog_circline_diag:
  assumes " H. circline_diag H  P H"
          " M H. P H  P (moebius_circline M H)"
  shows "P H"
proof-
  obtain M H' where "moebius_circline M H = H'" "circline_diag H'"
    using circline_diagonalize[of H]
    by auto
  hence "P (moebius_circline M H)"
    using assms(1)
    by simp
  thus ?thesis
    using assms(2)[of "moebius_circline M H" "moebius_inv M"]
    by simp
qed

(* ----------------------------------------------------------------- *)
subsubsection ‹Zero type circline set cardinality›
(* ----------------------------------------------------------------- *)

lemma circline_type_zero_card_eq1_0:
  assumes "circline_type H = 0" and "0h  circline_set H"
  shows "circline_set H = {0h}"
using assms
unfolding circline_set_def
proof(safe)
  fix z
  assume "on_circline H z" "circline_type H = 0" "on_circline H 0h"
  hence "H = circline_point_0"
    using unique_circline_type_zero_0'
    unfolding circline_set_def
    by simp
  thus "z = 0h"
    using ‹on_circline H z
    by (transfer, transfer) (case_tac z, case_tac H, force simp add: vec_cnj_def)
qed


lemma circline_type_zero_card_eq1:
  assumes "circline_type H = 0"
  shows " z. circline_set H = {z}"
proof-
  have " z. on_circline H z"
    using assms
  proof (transfer, transfer)
    fix H
    assume hh: "hermitean H  H  mat_zero"
    obtain A B C D where HH: "H = (A, B, C, D)"
      by (cases H) auto
    hence "C = cnj B" "is_real A" "is_real D"
      using hh hermitean_elems[of A B C D]
      by auto
    assume "circline_type_cmat H = 0"
    hence "mat_det H = 0"
      by (simp add: complex_eq_if_Re_eq hh mat_det_hermitean_real sgn_eq_0_iff)
    hence "A*D = B*C"
      using HH
      by simp
    show "Bex {v. v  vec_zero} (on_circline_cmat_cvec H)"
    proof (cases "A  0  B  0")
      case True
      thus ?thesis
        using HH A*D = B*C
        by (rule_tac x="(-B, A)" in bexI) (auto simp add: Let_def vec_cnj_def field_simps)
    next
      case False
      thus ?thesis
        using HH C = cnj B
        by (rule_tac x="(1, 0)" in bexI) (simp_all add: Let_def vec_cnj_def)
    qed
  qed
  then obtain z where "on_circline H z"
    by auto
  obtain M where "moebius_pt M z = 0h"
    using ex_moebius_1[of z]
    by auto
  hence "0h  circline_set (moebius_circline M H)"
    using on_circline_moebius_circline_I[OF ‹on_circline H z, of M]
    unfolding circline_set_def
    by simp
  hence "circline_set (moebius_circline M H) = {0h}"
    using circline_type_zero_card_eq1_0[of "moebius_circline M H"] ‹circline_type H = 0
    by auto
  hence "circline_set H = {z}"
    using ‹moebius_pt M z = 0h
    using bij_moebius_pt[of M] bij_image_singleton[of "moebius_pt M" "circline_set H" _ z]
    by simp
  thus ?thesis
    by auto
qed

(* ----------------------------------------------------------------- *)
subsubsection ‹Negative type circline set cardinality›
(* ----------------------------------------------------------------- *)

lemma quad_form_diagonal_iff:
  assumes "k1  0" and "is_real k1" and "is_real k2" and "Re k1 * Re k2 < 0"
  shows "quad_form (z1, 1) (k1, 0, 0, k2) = 0  ( φ. z1 = rcis (sqrt (Re (-k2 /k1))) φ)"
proof-
  have "Re (-k2/k1)  0"
    using ‹Re k1 * Re k2 < 0 ‹is_real k1 ‹is_real k2 k1  0
    using Re_divide_real[of k1 "-k2"]
    by (smt divide_less_0_iff mult_nonneg_nonneg mult_nonpos_nonpos uminus_complex.simps(1))

  have "quad_form (z1, 1) (k1, 0, 0, k2) = 0  (cor (cmod z1))2 = -k2 / k1"
    using assms add_eq_0_iff[of k2 "k1*(cor (cmod z1))2"]
    using eq_divide_imp[of k1 "(cor (cmod z1))2" "-k2"]
    by (auto simp add: vec_cnj_def field_simps complex_mult_cnj_cmod)
  also have "...  (cmod z1)2 = Re (-k2 /k1)"
    using assms
    apply (subst complex_eq_if_Re_eq)
    using Re_complex_of_real[of "(cmod z1)2"] div_reals
    by auto
  also have "...  cmod z1 = sqrt (Re (-k2 /k1))"
    by (metis norm_ge_zero real_sqrt_ge_0_iff real_sqrt_pow2 real_sqrt_power)
  also have "...  ( φ. z1 = rcis (sqrt (Re (-k2 /k1))) φ)"
    using rcis_cmod_arg[of z1, symmetric] assms abs_of_nonneg[of "sqrt (Re (-k2/k1))"]
    using ‹Re (-k2/k1)  0
    by auto
  finally show ?thesis
    .
qed

lemma circline_type_neg_card_gt3_diag:
  assumes "circline_type H < 0" and "circline_diag H"
  shows " A B C. A  B  A  C  B  C  {A, B, C}  circline_set H"
  using assms
  unfolding circline_set_def
  apply (simp del: HOL.ex_simps)
proof (transfer, transfer)
  fix H
  assume hh: "hermitean H  H  mat_zero"
  obtain A B C D where HH: "H = (A, B, C, D)"
    by (cases H) auto
  hence HH_elems: "is_real A" "is_real D" "C = cnj B"
    using hermitean_elems[of A B C D] hh
    by auto
  assume "circline_type_cmat H < 0" "is_diag_circline_cmat H"
  hence "B = 0" "C = 0" "Re A * Re D < 0" "A  0"
    using HH ‹is_real A ‹is_real D
    by auto

  let ?x = "sqrt (Re (- D / A))"
  let ?A = "(rcis ?x 0, 1)"
  let ?B = "(rcis ?x (pi/2), 1)"
  let ?C = "(rcis ?x pi, 1)"
  from quad_form_diagonal_iff[OF A  0 ‹is_real A ‹is_real D ‹Re A * Re D < 0]
  have "quad_form ?A (A, 0, 0, D) = 0"  "quad_form ?B (A, 0, 0, D) = 0"  "quad_form ?C (A, 0, 0, D) = 0"
    by (auto simp del: rcis_zero_arg)
  hence "on_circline_cmat_cvec H ?A  on_circline_cmat_cvec H ?B  on_circline_cmat_cvec H ?C"
    using HH B = 0 C = 0
    by simp
  moreover                                    
  have "Re (D / A) < 0"
    using ‹Re A * Re D < 0 A  0 ‹is_real A ‹is_real D
    using Re_divide_real[of A D]
    by (metis Re_complex_div_lt_0 Re_mult_real div_reals eq_cnj_iff_real is_real_div)
  hence "¬ ?A v ?B  ¬ ?A v ?C  ¬ ?B v ?C"
    unfolding rcis_def
    by (auto simp add: cis_def complex.corec)
  moreover
  have "?A  vec_zero" "?B  vec_zero" "?C  vec_zero"
    by auto
  ultimately
  show "A{v. v  vec_zero}. B{v. v  vec_zero}. C{v. v  vec_zero}.
            ¬ A v B  ¬ A v C  ¬ B v C 
            on_circline_cmat_cvec H A  on_circline_cmat_cvec H B  on_circline_cmat_cvec H C"
    by blast
qed

lemma circline_type_neg_card_gt3:
  assumes "circline_type H < 0"
  shows " A B C. A  B  A  C  B  C  {A, B, C}  circline_set H"
proof-
  obtain M H' where "moebius_circline M H = H'" "circline_diag H'"
    using circline_diagonalize[of H] assms
    by auto
  moreover
  hence "circline_type H' < 0"
    using assms moebius_preserve_circline_type
    by auto
  ultimately
  obtain A B C where "A  B" "A  C" "B  C" "{A, B, C}  circline_set H'"
    using circline_type_neg_card_gt3_diag[of H']
    by auto
  let ?iM = "moebius_inv M"
  have "moebius_circline ?iM H' = H"
    using ‹moebius_circline M H = H'[symmetric]
    by simp
  let ?A = "moebius_pt ?iM A" and ?B= "moebius_pt ?iM B" and ?C = "moebius_pt ?iM C"
  have "?A  circline_set H"  "?B  circline_set H"  "?C  circline_set H"
    using ‹moebius_circline ?iM H' = H[symmetric] {A, B, C}  circline_set H'
    by simp_all
  moreover
  have "?A  ?B" "?A  ?C" "?B  ?C"
    using A  B A  C B  C
    by auto
  ultimately
  show ?thesis
    by auto
qed

(* ----------------------------------------------------------------- *)
subsubsection ‹Positive type circline set cardinality›
(* ----------------------------------------------------------------- *)

lemma circline_type_pos_card_eq0_diag:
  assumes "circline_diag H" and "circline_type H > 0"
  shows "circline_set H = {}"
using assms
unfolding circline_set_def
apply simp
proof (transfer, transfer)
  fix H
  assume hh: "hermitean H  H  mat_zero"
  obtain A B C D where HH: "H = (A, B, C, D)"
    by (cases H) auto
  hence HH_elems: "is_real A" "is_real D" "C = cnj B"
    using hermitean_elems[of A B C D] hh
    by auto
  assume "is_diag_circline_cmat H" "0 < circline_type_cmat H"
  hence "B = 0" "C = 0" "Re A * Re D > 0" "A  0"
    using HH ‹is_real A ‹is_real D
    by auto
  show "x{v. v  vec_zero}. ¬ on_circline_cmat_cvec H x"
  proof
    fix x
    assume "x  {v. v  vec_zero}"
    obtain x1 x2 where xx: "x = (x1, x2)"
      by (cases x, auto)
    have "(Re A > 0  Re D > 0)  (Re A < 0  Re D < 0)"
      using ‹Re A * Re D > 0
      by (metis linorder_neqE_linordered_idom mult_eq_0_iff zero_less_mult_pos zero_less_mult_pos2)
    moreover
    have "(Re (x1 * cnj x1)  0  Re (x2 * cnj x2) > 0)  (Re (x1 * cnj x1) > 0  Re (x2 * cnj x2)  0)"
      using x  {v. v  vec_zero} xx
      apply auto
      apply (simp add: complex_neq_0 power2_eq_square)+
      done
    ultimately
    have "Re A * Re (x1 * cnj x1) + Re D * Re (x2 * cnj x2)  0"
      by (smt mult_neg_pos mult_nonneg_nonneg mult_nonpos_nonneg mult_pos_pos)
    hence "A * (x1 * cnj x1) + D * (x2 * cnj x2)  0"
      using ‹is_real A ‹is_real D
      by (metis Re_mult_real plus_complex.simps(1) zero_complex.simps(1))
    thus "¬ on_circline_cmat_cvec H x"
      using HH B = 0 C = 0 xx
      by (simp add: vec_cnj_def field_simps)
  qed
qed

lemma circline_type_pos_card_eq0:
  assumes "circline_type H > 0"
  shows "circline_set H = {}"
proof-
  obtain M H' where "moebius_circline M H = H'" "circline_diag H'"
    using circline_diagonalize[of H] assms
    by auto
  moreover
  hence "circline_type H' > 0"
    using assms moebius_preserve_circline_type
    by auto
  ultimately
  have "circline_set H' = {}"
    using circline_type_pos_card_eq0_diag[of H']
    by auto
  let ?iM = "moebius_inv M"
  have "moebius_circline ?iM H' = H"
    using ‹moebius_circline M H = H'[symmetric]
    by simp
  thus ?thesis
    using ‹circline_set H' = {}
    by auto
qed

(* ----------------------------------------------------------------- *)
subsubsection ‹Cardinality determines type›
(* ----------------------------------------------------------------- *)

lemma card_eq1_circline_type_zero:
  assumes " z. circline_set H = {z}"
  shows "circline_type H = 0"
proof (cases "circline_type H < 0")
  case True
  thus ?thesis
    using circline_type_neg_card_gt3[of H] assms
    by auto
next
  case False
  show ?thesis
  proof (cases "circline_type H > 0")
    case True
    thus ?thesis
      using circline_type_pos_card_eq0[of H] assms
      by auto
  next
    case False
    thus ?thesis
      using ¬ (circline_type H) < 0
      by simp
  qed
qed

(* ----------------------------------------------------------------- *)
subsubsection ‹Circline set is injective›
(* ----------------------------------------------------------------- *)

lemma inj_circline_set:
  assumes "circline_set H = circline_set H'" and "circline_set H  {}"
  shows "H = H'"
proof (cases "circline_type H < 0")
  case True
  then obtain A B C where "A  B" "A  C" "B  C" "{A, B, C}  circline_set H"
    using circline_type_neg_card_gt3[of H]
    by auto
  hence "∃!H. A  circline_set H  B  circline_set H  C  circline_set H"
    using unique_circline_set[of A B C]
    by simp
  thus ?thesis
    using ‹circline_set H = circline_set H' {A, B, C}  circline_set H
    by auto
next
  case False
  show ?thesis
  proof (cases "circline_type H = 0")
    case True
    moreover
    then obtain A where "{A} = circline_set H"
      using circline_type_zero_card_eq1[of H]
      by auto
    moreover
    hence "circline_type H' = 0"
      using ‹circline_set H = circline_set H' card_eq1_circline_type_zero[of H']
      by auto
    ultimately
    show ?thesis
      using unique_circline_type_zero[of A] ‹circline_set H = circline_set H'
      by auto
  next
    case False
    hence "circline_type H > 0"
      using ¬ (circline_type H < 0)
      by auto
    thus ?thesis
      using ‹circline_set H  {}  circline_type_pos_card_eq0[of H]
      by auto
  qed
qed

(* ----------------------------------------------------------------- *)
subsection ‹Circline points - cross ratio real›
(* ----------------------------------------------------------------- *)

lemma four_points_on_circline_iff_cross_ratio_real:
  assumes "distinct [z, u, v, w]"
  shows "is_real (to_complex (cross_ratio z u v w))  
         ( H. {z, u, v, w}  circline_set H)"
proof-
  have " z. distinct [z, u, v, w]  is_real (to_complex (cross_ratio z u v w))  ( H. {z, u, v, w}  circline_set H)"
       (is "?P u v w")
  proof (rule wlog_moebius_01inf[of ?P u v w])
    fix M a b c
    assume aa: "?P a b c"
    let ?Ma = "moebius_pt M a" and ?Mb = "moebius_pt M b" and ?Mc = "moebius_pt M c"
    show "?P ?Ma ?Mb ?Mc"
    proof (rule allI, rule impI)
      fix z
      obtain d where *: "z = moebius_pt M d"
        using bij_moebius_pt[of M]
        unfolding bij_def
        by auto
      let ?Md = "moebius_pt M d"
      assume "distinct [z, moebius_pt M a, moebius_pt M b, moebius_pt M c]"
      hence "distinct [a, b, c, d]"
        using *
        by auto
      moreover
      have "( H. {d, a, b, c}  circline_set H)  ( H. {z, ?Ma, ?Mb, ?Mc}  circline_set H)"
        using *
        apply auto
        apply (rule_tac x="moebius_circline M H" in exI, simp)
        apply (rule_tac x="moebius_circline (moebius_inv M) H" in exI, simp)
        done
      ultimately
      show "is_real (to_complex (cross_ratio z ?Ma ?Mb ?Mc)) = (H. {z, ?Ma, ?Mb, ?Mc}  circline_set H)"
        using aa[rule_format, of d] *
        by auto
    qed
  next
    show "?P 0h 1h h"
    proof safe
      fix z
      assume "distinct [z, 0h, 1h, h]"
      hence "z  h"
        by auto
      assume "is_real (to_complex (cross_ratio z 0h 1h h))"
      hence "is_real (to_complex z)"
        by simp
      hence "z  circline_set x_axis"
        using of_complex_to_complex[symmetric, OF z  h]
        using circline_set_x_axis
        by auto
      thus "H. {z, 0h, 1h, h}  circline_set H"
        by (rule_tac x=x_axis in exI, auto)
    next
      fix z H
      assume *: "distinct [z, 0h, 1h, h]" "{z, 0h, 1h, h}  circline_set H"
      hence "H = x_axis"
        by auto
      hence "z  circline_set x_axis"
        using *
        by auto
      hence "is_real (to_complex z)"
        using * circline_set_x_axis
        by auto
      thus "is_real (to_complex (cross_ratio z 0h 1h h))"
        by simp
    qed
  next
    show "u  v" "v  w" "u  w"
      using assms
      by auto
  qed
  thus ?thesis
    using assms
    by auto
qed

(* ----------------------------------------------------------------- *)
subsection ‹Symmetric points wrt. circline›
(* ----------------------------------------------------------------- *)

text ‹In the extended complex plane there are no substantial differences between circles and lines,
so we will consider only one kind of relation and call two points \emph{circline symmetric} if they
are mapped to one another using either reflection or inversion over arbitrary line or circle. Points
are symmetric iff the bilinear form of their representation vectors and matrix is zero.›

definition circline_symmetric_cvec_cmat :: "complex_vec  complex_vec  complex_mat  bool" where
  [simp]: "circline_symmetric_cvec_cmat z1 z2 H  bilinear_form z1 z2 H = 0"
lift_definition circline_symmetric_hcoords_clmat :: "complex_homo_coords  complex_homo_coords  circline_mat  bool" is circline_symmetric_cvec_cmat
  done
lift_definition circline_symmetric :: "complex_homo  complex_homo  circline  bool" is circline_symmetric_hcoords_clmat
  apply transfer
  apply (simp del: bilinear_form_def)
  apply (erule exE)+
  apply (simp add: bilinear_form_scale_m bilinear_form_scale_v1 bilinear_form_scale_v2 del: vec_cnj_sv quad_form_def bilinear_form_def)
  done

lemma symmetry_principle [simp]:
  assumes "circline_symmetric z1 z2 H"
  shows "circline_symmetric (moebius_pt M z1) (moebius_pt M z2) (moebius_circline M H)"
  using assms
  by (transfer, transfer, simp del: bilinear_form_def congruence_def)

text ‹Symmetry wrt. @{term "unit_circle"}
lemma circline_symmetric_0inf_disc [simp]:
  shows "circline_symmetric 0h h unit_circle"
  by (transfer, transfer, simp add: vec_cnj_def)

lemma circline_symmetric_inv_homo_disc [simp]:
  shows "circline_symmetric a (inversion a) unit_circle"
  unfolding inversion_def
  by (transfer, transfer) (case_tac a, auto simp add: vec_cnj_def)

lemma circline_symmetric_inv_homo_disc':
  assumes "circline_symmetric a a' unit_circle"
  shows "a' = inversion a"
  unfolding inversion_def
  using assms
proof (transfer, transfer)
  fix a a'
  assume vz: "a  vec_zero" "a'  vec_zero"
  obtain a1 a2 where aa: "a = (a1, a2)"
    by (cases a, auto)
  obtain a1' a2' where aa': "a' = (a1', a2')"
    by (cases a', auto)
  assume *: "circline_symmetric_cvec_cmat a a' unit_circle_cmat"
  show "a' v (conjugate_cvec  reciprocal_cvec) a"
  proof (cases "a1' = 0")
    case True
    thus ?thesis
      using aa aa' vz *
      by (auto simp add: vec_cnj_def field_simps)
  next
    case False
    show ?thesis
    proof (cases "a2 = 0")
      case True
      thus ?thesis
        using a1'  0
        using aa aa' * vz
        by (simp add:  vec_cnj_def field_simps)
    next
      case False
      thus ?thesis
        using a1'  0 aa aa' *
        by (simp add: vec_cnj_def field_simps) (rule_tac x="cnj a2 / a1'" in exI, simp add: field_simps)
    qed
  qed
qed

lemma ex_moebius_circline_x_axis:
  assumes "circline_type H < 0"
  shows " M. moebius_circline M H = x_axis"
proof-
  obtain A B C where *: "A  B" "A  C" "B  C" "on_circline H A" "on_circline H B" "on_circline H C"
    using circline_type_neg_card_gt3[OF assms]
    unfolding circline_set_def
    by auto
  then obtain M where "moebius_pt M A = 0h" "moebius_pt M B = 1h" "moebius_pt M C = h"
    using ex_moebius_01inf by blast
  hence "moebius_circline M H = x_axis"
    using *
    by (metis circline_set_I circline_set_moebius_circline rev_image_eqI unique_circline_01inf')
  thus ?thesis
    by blast
qed

lemma wlog_circline_x_axis:
  assumes "circline_type H < 0"
  assumes " M H. P H  P (moebius_circline M H)"
  assumes "P x_axis"
  shows "P H"
proof-
  obtain M where "moebius_circline M H = x_axis"
    using ex_moebius_circline_x_axis[OF assms(1)]
    by blast
  then obtain M' where "moebius_circline M' x_axis = H"
    by (metis moebius_circline_comp_inv_left)
  thus ?thesis
    using assms(2)[of x_axis M'] assms(3)
    by simp
qed

lemma circline_intersection_at_most_2_points:
  assumes "H1  H2"
  shows "finite (circline_intersection H1 H2)  card (circline_intersection H1 H2)  2"
proof (rule ccontr)
  assume "¬ ?thesis"
  hence "infinite (circline_intersection H1 H2)  card (circline_intersection H1 H2) > 2"
    by auto
  hence " A B C. A  B  B  C  A  C  {A, B, C}  circline_intersection H1 H2"
  proof
    assume "card (circline_intersection H1 H2) > 2"
    thus ?thesis
      using card_geq_3_iff_contains_3_elems[of "circline_intersection H1 H2"]
      by auto
  next
    assume "infinite (circline_intersection H1 H2)"
    thus ?thesis
      using infinite_contains_3_elems
      by blast
  qed
  then obtain A B C where "A  B" "B  C" "A  C" "{A, B, C}  circline_intersection H1 H2"
    by blast
  hence "H2 = H1"
    using circline_intersection_def mem_Collect_eq unique_circline_set by fastforce
  thus False
    using assms
    by simp
qed
              
end

Theory Oriented_Circlines

(* -------------------------------------------------------------------------- *)
section ‹Oriented circlines›
(* -------------------------------------------------------------------------- *)
theory Oriented_Circlines
imports Circlines
begin

(* ----------------------------------------------------------------- *)
subsection ‹Oriented circlines definition›
(* ----------------------------------------------------------------- *)

text ‹In this section we describe how the orientation is introduced for the circlines. Similarly as
the set of circline points, the set of disc points is introduced using the quadratic form induced by
the circline matrix --- the set of points of the circline disc is the set of points such that
satisfy that $A\cdot z\cdot \overline{z} + B\cdot \overline{z} + C\cdot z + D < 0$, where
$(A, B, C, D)$ is a circline matrix representative Hermitean matrix. As the
set of disc points must be invariant to the choice of representative, it is clear that oriented
circlines matrices are equivalent only if they are proportional by a positive real factor (recall
that unoriented circline allowed arbitrary non-zero real factors).›

definition ocircline_eq_cmat :: "complex_mat  complex_mat  bool" where
  [simp]: "ocircline_eq_cmat A B ( k::real. k > 0  B = cor k *sm A)"
lift_definition ocircline_eq_clmat :: "circline_mat  circline_mat  bool" is ocircline_eq_cmat
  done

lemma ocircline_eq_cmat_id [simp]:
  shows "ocircline_eq_cmat H H"
  by (simp, rule_tac x=1 in exI, simp)

quotient_type ocircline = circline_mat / ocircline_eq_clmat
proof (rule equivpI)
  show "reflp ocircline_eq_clmat"
    unfolding reflp_def
    by transfer (auto, rule_tac x="1" in exI, simp)
next
  show "symp ocircline_eq_clmat"
    unfolding symp_def
    by transfer (simp only: ocircline_eq_cmat_def, safe, rule_tac x="1/k" in exI, simp)
next
  show "transp ocircline_eq_clmat"
    unfolding transp_def
    by transfer (simp only: ocircline_eq_cmat_def, safe, rule_tac x="k*ka" in exI, simp)
qed

(* ----------------------------------------------------------------- *)
subsection ‹Points on oriented circlines›
(* ----------------------------------------------------------------- *)

text ‹Boundary of the circline.›

lift_definition on_ocircline :: "ocircline  complex_homo  bool" is on_circline_clmat_hcoords
  by transfer (simp del: quad_form_def, (erule exE)+, simp add: quad_form_scale_m quad_form_scale_v del: quad_form_def)

definition ocircline_set :: "ocircline  complex_homo set" where
  "ocircline_set H = {z. on_ocircline H z}"

lemma ocircline_set_I [simp]:
  assumes "on_ocircline H z"
  shows "z  ocircline_set H"
  using assms
  unfolding ocircline_set_def
  by simp

(* ----------------------------------------------------------------- *)
subsection ‹Disc and disc complement - in and out points›
(* ----------------------------------------------------------------- *)

text ‹Interior and the exterior of an oriented circline.›

definition in_ocircline_cmat_cvec :: "complex_mat  complex_vec  bool" where
  [simp]: "in_ocircline_cmat_cvec H z  Re (quad_form z H) < 0"
lift_definition in_ocircline_clmat_hcoords :: "circline_mat  complex_homo_coords  bool" is in_ocircline_cmat_cvec
  done
lift_definition in_ocircline :: "ocircline  complex_homo  bool" is in_ocircline_clmat_hcoords
proof transfer
  fix H H' z z'
  assume hh: "hermitean H  H  mat_zero" and "hermitean H'  H'  mat_zero" and
             "z  vec_zero" and "z'  vec_zero"
  assume "ocircline_eq_cmat H H'" and "z v z'"
  then obtain k k' where
    *: "0 < k" "H' = cor k *sm H" "k'  0" "z' = k' *sv  z"
    by auto
  hence "quad_form z' H' = cor k * cor ((cmod k')2) * quad_form z H"
    by (simp add: quad_form_scale_v quad_form_scale_m del: vec_cnj_sv quad_form_def)
  hence "Re (quad_form z' H') = k * (cmod k')2 * Re (quad_form z H)"
    using hh quad_form_hermitean_real[of H]
    by (simp add: power2_eq_square)
  thus "in_ocircline_cmat_cvec H z = in_ocircline_cmat_cvec H' z'"
    using k > 0 k'  0
    using mult_less_0_iff
    by fastforce
qed

definition disc :: "ocircline  complex_homo set" where
  "disc H = {z. in_ocircline H z}"

lemma disc_I [simp]:
  assumes "in_ocircline H z"
  shows "z  disc H"
  using assms
  unfolding disc_def
  by simp

definition out_ocircline_cmat_cvec :: "complex_mat  complex_vec  bool" where
  [simp]: "out_ocircline_cmat_cvec H z  Re (quad_form z H) > 0"
lift_definition out_ocircline_clmat_hcoords :: "circline_mat  complex_homo_coords  bool" is out_ocircline_cmat_cvec
  done
lift_definition out_ocircline :: "ocircline  complex_homo  bool" is out_ocircline_clmat_hcoords
proof transfer
  fix H H' z z'
  assume hh: "hermitean H  H  mat_zero" "hermitean H'  H'  mat_zero"
             "z  vec_zero" "z'  vec_zero"
  assume "ocircline_eq_cmat H H'" "z v z'"
  then obtain k k' where
    *: "0 < k" "H' = cor k *sm H" "k'  0" "z' = k' *sv  z"
    by auto
  hence "quad_form z' H' = cor k * cor ((cmod k')2) * quad_form z H"
    by (simp add: quad_form_scale_v quad_form_scale_m del: vec_cnj_sv quad_form_def)
  hence "Re (quad_form z' H') = k * (cmod k')2 * Re (quad_form z H)"
    using hh quad_form_hermitean_real[of H]
    by (simp add: power2_eq_square)
  thus "out_ocircline_cmat_cvec H z = out_ocircline_cmat_cvec H' z'"
    using k > 0 k'  0
    using zero_less_mult_pos
    by fastforce
qed

definition disc_compl :: "ocircline  complex_homo set" where
  "disc_compl H = {z. out_ocircline H z}"

text ‹These three sets are mutually disjoint and they fill up the entire plane.›

lemma disc_compl_I [simp]:
  assumes "out_ocircline H z"
  shows "z  disc_compl H"
  using assms
  unfolding disc_compl_def
  by simp

lemma in_on_out:
  shows "in_ocircline H z  on_ocircline H z  out_ocircline H z"
  apply (transfer, transfer)
  using quad_form_hermitean_real
  using complex_eq_if_Re_eq
  by auto

lemma in_on_out_univ:
  shows "disc H  disc_compl H  ocircline_set H = UNIV"
  unfolding disc_def disc_compl_def ocircline_set_def
  using in_on_out[of H]
  by auto

lemma disc_inter_disc_compl [simp]:
  shows "disc H  disc_compl H = {}"
  unfolding disc_def disc_compl_def
  by auto (transfer, transfer, simp)

lemma disc_inter_ocircline_set [simp]:
  shows "disc H  ocircline_set H = {}"
  unfolding disc_def ocircline_set_def
  by auto (transfer, transfer, simp)

lemma disc_compl_inter_ocircline_set [simp]:
  shows "disc_compl H  ocircline_set H = {}"
  unfolding disc_compl_def ocircline_set_def
  by auto (transfer, transfer, simp)

(* ----------------------------------------------------------------- *)
subsection ‹Opposite orientation›
(* ----------------------------------------------------------------- *)

text ‹Finding opposite circline is idempotent, and opposite circlines share the same set of points,
but exchange disc and its complement.›

definition opposite_ocircline_cmat :: "complex_mat  complex_mat" where
  [simp]: "opposite_ocircline_cmat H = (-1) *sm H"
lift_definition opposite_ocircline_clmat :: "circline_mat  circline_mat" is opposite_ocircline_cmat
  by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition opposite_ocircline :: "ocircline  ocircline" is opposite_ocircline_clmat
  by transfer auto

lemma opposite_ocircline_involution [simp]:
  shows "opposite_ocircline (opposite_ocircline H) = H"
  by (transfer, transfer) (auto, rule_tac x="1" in exI, simp)

lemma on_circline_opposite_ocircline_cmat [simp]:
  assumes "hermitean H  H  mat_zero" and "z  vec_zero"
  shows "on_circline_cmat_cvec (opposite_ocircline_cmat H) z = on_circline_cmat_cvec H z"
  using assms
  by (simp add: quad_form_scale_m del: quad_form_def)

lemma on_circline_opposite_ocircline [simp]:
  shows "on_ocircline (opposite_ocircline H) z  on_ocircline H z"
  using on_circline_opposite_ocircline_cmat
  by (transfer, transfer, simp)

lemma ocircline_set_opposite_ocircline [simp]:
  shows "ocircline_set (opposite_ocircline H) = ocircline_set H"
  unfolding ocircline_set_def
  by auto

lemma disc_compl_opposite_ocircline [simp]:
  shows "disc_compl (opposite_ocircline H) = disc H"
  unfolding disc_def disc_compl_def
  apply auto
   apply (transfer, transfer)
   apply (auto simp add: quad_form_scale_m simp del: quad_form_def)
  apply (transfer ,transfer)
  apply (auto simp add: quad_form_scale_m simp del: quad_form_def)
  done

lemma disc_opposite_ocircline [simp]:
  shows "disc (opposite_ocircline H) = disc_compl H"
  using disc_compl_opposite_ocircline[of "opposite_ocircline H"]
  by simp

(* ----------------------------------------------------------------- *)
subsection ‹Positive orientation. Conversion between unoriented and oriented circlines›
(* ----------------------------------------------------------------- *)

text ‹Given an oriented circline, one can trivially obtain its unoriented counterpart, and these two
share the same set of points.›

lift_definition of_ocircline :: "ocircline  circline" is "id::circline_mat  circline_mat"
  by transfer (simp, erule exE, force)

lemma of_ocircline_opposite_ocircline [simp]:
  shows "of_ocircline (opposite_ocircline H) = of_ocircline H"
  by (transfer, transfer) (simp, erule exE, rule_tac x="-1" in exI, simp)

lemma on_ocircline_of_circline [simp]:
  shows "on_circline (of_ocircline H) z  on_ocircline H z"
  by (transfer, transfer, simp)

lemma circline_set_of_ocircline [simp]:
  shows "circline_set (of_ocircline H) = ocircline_set H"
  unfolding ocircline_set_def circline_set_def
  by (safe) (transfer, simp)+

lemma inj_of_ocircline:
  assumes "of_ocircline H = of_ocircline H'"
  shows "H = H'  H = opposite_ocircline H'"
  using assms
  by (transfer, transfer) (simp, metis linorder_neqE_linordered_idom minus_of_real_eq_of_real_iff mult_minus1 mult_sm_distribution neg_0_equal_iff_equal neg_less_0_iff_less)

lemma inj_ocircline_set:
  assumes "ocircline_set H = ocircline_set H'" and "ocircline_set H  {}"
  shows "H = H'  H = opposite_ocircline H'"
proof-
  from assms 
  have "circline_set (of_ocircline H) = circline_set (of_ocircline H')"
       "circline_set (of_ocircline H')  {}"
    by auto
  hence "of_ocircline H = of_ocircline H'"
    by (simp add: inj_circline_set)
  thus ?thesis
    by (rule inj_of_ocircline)
qed

text ‹Positive orientation.›

text ‹Given a representative Hermitean matrix of a circline, it represents exactly one of the two
possible oriented circlines. The choice of what should be called a positive orientation is
arbitrary. We follow Schwerdtfeger \cite{schwerdtfeger}, use the leading coefficient $A$ as the
first criterion, and say that circline matrices with $A > 0$ are called positively oriented, and
with $A < 0$ negatively oriented. However, Schwerdtfeger did not discuss the possible case of $A =
0$ (the case of lines), so we had to extend his definition to achieve a total characterization.›

definition pos_oriented_cmat :: "complex_mat  bool" where
  [simp]: "pos_oriented_cmat H 
           (let (A, B, C, D) = H
              in (Re A > 0  (Re A = 0  ((B  0  arg B > 0)  (B = 0  Re D > 0)))))"
lift_definition pos_oriented_clmat :: "circline_mat  bool" is pos_oriented_cmat
  done

lift_definition pos_oriented :: "ocircline  bool" is pos_oriented_clmat
  by transfer
     (case_tac circline_mat1, case_tac circline_mat2, simp, erule exE, simp, 
      metis mult_pos_pos zero_less_mult_pos)

lemma pos_oriented:
  shows "pos_oriented H  pos_oriented (opposite_ocircline H)"
proof (transfer, transfer)
  fix H
  assume hh: "hermitean H  H  mat_zero"
  obtain A B C D where HH: "H = (A, B, C, D)"
    by (cases H) auto
  moreover
  hence "Re A = 0  Re D = 0  B  0"
    using hh hermitean_elems[of A B C D]
    by (cases A, cases D) (auto simp add: Complex_eq)
  moreover
  have "B  0  ¬ 0 < arg B  0 < arg (- B)"
    using canon_ang_plus_pi2[of "arg B"] arg_bounded[of B]
    by (auto simp add: arg_uminus)
  ultimately
  show "pos_oriented_cmat H  pos_oriented_cmat (opposite_ocircline_cmat H)"
    by auto
qed

lemma pos_oriented_opposite_ocircline_cmat [simp]:
  assumes "hermitean H  H  mat_zero"
  shows  "pos_oriented_cmat (opposite_ocircline_cmat H)  ¬ pos_oriented_cmat H"
proof-
  obtain A B C D where HH: "H = (A, B, C, D)"
    by (cases H) auto
  moreover
  hence "Re A = 0  Re D = 0  B  0"
    using assms hermitean_elems[of A B C D]
    by (cases A, cases D) (auto simp add: Complex_eq)
  moreover
  have "B  0  ¬ 0 < arg B  0 < arg (- B)"
    using canon_ang_plus_pi2[of "arg B"] arg_bounded[of B]
    by (auto simp add: arg_uminus)
  moreover
  have "B  0  0 < arg B  ¬ 0 < arg (- B)"
    using canon_ang_plus_pi1[of "arg B"] arg_bounded[of B]
    by (auto simp add: arg_uminus)
  ultimately
  show "pos_oriented_cmat (opposite_ocircline_cmat H) = (¬ pos_oriented_cmat H)"
    by simp (metis not_less_iff_gr_or_eq)
qed

lemma pos_oriented_opposite_ocircline [simp]:
  shows "pos_oriented (opposite_ocircline H)  ¬ pos_oriented H"
  using pos_oriented_opposite_ocircline_cmat
  by (transfer, transfer, simp)

lemma pos_oriented_circle_inf:
  assumes "h  ocircline_set H"
  shows "pos_oriented H  h  disc H"
  using assms
  unfolding ocircline_set_def disc_def
  apply simp
proof (transfer, transfer)
  fix H
  assume hh: "hermitean H  H  mat_zero"
  obtain A B C D where HH: "H = (A, B, C, D)"
    by (cases H) auto
  hence "is_real A"
    using hh hermitean_elems
    by auto
  assume "¬ on_circline_cmat_cvec H v"
  thus "pos_oriented_cmat H = (¬ in_ocircline_cmat_cvec H  v)"
    using HH ‹is_real A
    by (cases A) (auto simp add: vec_cnj_def Complex_eq)
qed

lemma pos_oriented_euclidean_circle:
  assumes "is_circle (of_ocircline H)"
          "(a, r) = euclidean_circle (of_ocircline H)"
          "circline_type (of_ocircline H) < 0"
  shows "pos_oriented H  of_complex a  disc H"
  using assms
  unfolding disc_def
  apply simp
proof (transfer, transfer)
  fix H a r
  assume hh: "hermitean H  H  mat_zero"
  obtain A B C D where HH: "H = (A, B, C, D)"
    by (cases H) auto
  hence "is_real A" "is_real D" "C = cnj B"
    using hh hermitean_elems
    by auto

  assume *: "¬ circline_A0_cmat (id H)" "(a, r) = euclidean_circle_cmat (id H)" "circline_type_cmat (id H) < 0"
  hence "A  0" "Re A  0"
    using HH ‹is_real A
    by (case_tac[!] A) (auto simp add: Complex_eq)

  have "Re (A*D - B*C) < 0"
    using ‹circline_type_cmat (id H) < 0 HH
    by simp

  have **: "(A * (D * cnj A) - B * (C * cnj A)) / (A * cnj A) = (A*D - B*C) / A"
    using A  0
    by (simp add: field_simps)
  hence ***: "0 < Re A  Re ((A * (D * cnj A) - B * (C * cnj A)) / (A * cnj A)) < 0"
    using ‹is_real A A  0 ‹Re (A*D - B*C) < 0
    by (simp add: Re_divide_real divide_less_0_iff)

  have "Re D - Re (cnj B * B / cnj A) < Re ((C - cnj B * A / cnj A) * B / A)" if "Re A > 0"
    using HH * ‹is_real A that
    by simp (smt "**" "***" cnj.simps(1) cnj.simps(2) complex_eq diff_divide_distrib left_diff_distrib'
               minus_complex.simps(1) mult.commute nonzero_mult_div_cancel_right)?
  moreover have "Re A > 0" if "Re D - Re (cnj B * B / cnj A) < Re ((C - cnj B * A / cnj A) * B / A)"
    using HH * ‹is_real A that
    by simp (smt "**" "***" cnj.simps(1) cnj.simps(2) complex_eq diff_divide_distrib left_diff_distrib'
               minus_complex.simps(1) mult.commute nonzero_mult_div_cancel_right)?
  ultimately show "pos_oriented_cmat H = in_ocircline_cmat_cvec H (of_complex_cvec a)"
    using HH ‹Re A  0 * ‹is_real A by (auto simp add: vec_cnj_def)
qed

text ‹Introduce positive orientation›

definition of_circline_cmat :: "complex_mat  complex_mat" where
 [simp]: "of_circline_cmat H = (if pos_oriented_cmat H then H else opposite_ocircline_cmat H)"

lift_definition of_circline_clmat :: "circline_mat  circline_mat" is of_circline_cmat
  by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)

lemma of_circline_clmat_def':
  shows "of_circline_clmat H = (if pos_oriented_clmat H then H else opposite_ocircline_clmat H)"
  by transfer simp

lemma pos_oriented_cmat_mult_positive':
  assumes
    "hermitean H1  H1  mat_zero" and
    "hermitean H2  H2  mat_zero" and
    "k. k > 0  H2 = cor k *sm H1" and
    "pos_oriented_cmat H1"
  shows "pos_oriented_cmat H2"
proof-
  obtain A1 B1 C1 D1 A2 B2 C2 D2
    where HH: "H1 = (A1, B1, C1, D1)" "H2 = (A2, B2, C2, D2)"
    by (cases H1, cases H2)
  thus ?thesis
    using assms
    by fastforce
qed

lemma pos_oriented_cmat_mult_positive:
  assumes
    "hermitean H1  H1  mat_zero" and
    "hermitean H2  H2  mat_zero" and
    "k. k > 0  H2 = cor k *sm H1"
  shows 
    "pos_oriented_cmat H1  pos_oriented_cmat H2"
proof-
  from assms(3) obtain k where "k > 0  H2 = cor k *sm H1"
    by auto
  hence "k. k > 0  H1 = cor k *sm H2"
    by (rule_tac x="1/k" in exI, auto)
  thus ?thesis
    using assms pos_oriented_cmat_mult_positive'
    by blast
qed


lemma pos_oriented_cmat_mult_negative:
  assumes
    "hermitean H1  H1  mat_zero" and
    "hermitean H2  H2  mat_zero" and
    "k. k < 0  H2 = cor k *sm H1"
  shows
    "pos_oriented_cmat H1  ¬ pos_oriented_cmat H2"
  using assms
proof-
  obtain A B C D A1 B1 C1 D1
    where *: "H1 = (A, B, C, D)" "H2 = (A1, B1, C1, D1)"
    by (cases H1, cases H2) auto
  hence **: "is_real A" "is_real D" "is_real A1" "is_real D1" "B = 0  C = 0" "B1 = 0  C1 = 0"
    using assms hermitean_elems[of A B C D] hermitean_elems[of A1 B1 C1 D1]
    by auto
  show ?thesis
  proof (rule iffI)
    assume H1: "pos_oriented_cmat H1"
    show "¬ pos_oriented_cmat H2"
    proof (cases "Re A > 0")
      case True
      thus ?thesis
        using assms * ** mult_neg_pos
        by fastforce
    next
      case False
      show ?thesis
      proof (cases "B = 0")
        case True
        thus ?thesis
          using assms * ** H1 ¬ Re A > 0 mult_neg_pos
          by fastforce
      next
        case False
        thus ?thesis
          using arg_uminus_opposite_sign[of B] arg_mult_real_negative
          using assms * ** H1 ¬ Re A > 0 mult_neg_pos
          by fastforce
      qed
    qed
  next
    assume H2: "¬ pos_oriented_cmat H2"
    show "pos_oriented_cmat H1"
    proof (cases "Re A > 0")
      case True
      thus ?thesis
        using * ** mult_neg_pos
        by fastforce
    next
      case False
      show ?thesis
      proof (cases "B = 0")
        case True
        thus ?thesis 
          using assms * ** H2 ¬ Re A > 0
          by simp (smt arg_0_iff arg_complex_of_real_negative arg_complex_of_real_positive arg_mult_eq complex_of_real_Re mult.right_neutral mult_eq_0_iff of_real_0 of_real_1 zero_complex.simps(1))
      next
        case False
        thus ?thesis
          using assms ¬ Re A > 0 H2 * **
          using arg_uminus_opposite_sign[of B]
          by (cases "Re A = 0", auto simp add: mult_neg_neg)
      qed
    qed
  qed
qed
   
lift_definition of_circline :: "circline  ocircline" is of_circline_clmat
proof transfer
  fix H1 H2
  assume hh:
    "hermitean H1  H1  mat_zero"
    "hermitean H2  H2  mat_zero"
  assume "circline_eq_cmat H1 H2"
  then obtain k where *: "k  0  H2 = cor k *sm H1"
    by auto
  show "ocircline_eq_cmat (of_circline_cmat H1) (of_circline_cmat H2)"
  proof (cases "k > 0")
    case True
    hence "pos_oriented_cmat H1 = pos_oriented_cmat H2"
      using * pos_oriented_cmat_mult_positive[OF hh]
      by blast
    thus ?thesis
      using hh * k > 0
      apply (simp del: pos_oriented_cmat_def)
      apply (rule conjI)
       apply (rule impI)
       apply (simp, rule_tac x=k in exI, simp)
      apply (rule impI)
      apply (simp, rule_tac x=k in exI, simp)
      done
  next
    case False
    hence "k < 0"
      using *
      by simp
    hence "pos_oriented_cmat H1  ¬ (pos_oriented_cmat H2)"
      using * pos_oriented_cmat_mult_negative[OF hh]
      by blast
    thus ?thesis
      using hh * k < 0
      apply (simp del: pos_oriented_cmat_def)
      apply (rule conjI)
       apply (rule impI)
       apply (simp, rule_tac x="-k" in exI, simp)
      apply (rule impI)
      apply (simp, rule_tac x="-k" in exI, simp)
      done
  qed
qed

lemma pos_oriented_of_circline [simp]:
  shows "pos_oriented (of_circline H)"
  using pos_oriented_opposite_ocircline_cmat
  by (transfer, transfer, simp)

lemma of_ocircline_of_circline [simp]:
  shows "of_ocircline (of_circline H) = H"
  apply (transfer, auto simp add: of_circline_clmat_def')
  apply (transfer, simp, rule_tac x="-1" in exI, simp)
  done

lemma of_circline_of_ocircline_pos_oriented [simp]:
  assumes "pos_oriented H"
  shows "of_circline (of_ocircline H) = H"
  using assms
  by (transfer, transfer, simp, rule_tac x=1 in exI, simp)

lemma inj_of_circline:
  assumes "of_circline H = of_circline H'"
  shows "H = H'"
  using assms
proof (transfer, transfer)
  fix H H'
  assume "ocircline_eq_cmat (of_circline_cmat H) (of_circline_cmat H')"
  then obtain k where "k > 0" "of_circline_cmat H' = cor k *sm of_circline_cmat H"
    by auto
  thus "circline_eq_cmat H H'"
    using mult_sm_inv_l[of "-1" "H'" "cor k *sm H"]
    using mult_sm_inv_l[of "-1" "H'" "(- (cor k)) *sm H"]
    apply (simp split: if_split_asm)
    apply (rule_tac x="k" in exI, simp)
    apply (rule_tac x="-k" in exI, simp)
    apply (rule_tac x="-k" in exI, simp)
    apply (rule_tac x="k" in exI, simp)
    done
qed

lemma of_circline_of_ocircline:
  shows "of_circline (of_ocircline H') = H'  
         of_circline (of_ocircline H') = opposite_ocircline H'"
proof (cases "pos_oriented H'")
  case True
  thus ?thesis
    by auto
next
  case False
  hence "pos_oriented (opposite_ocircline H')"
    using pos_oriented
    by auto
  thus ?thesis
    using of_ocircline_opposite_ocircline[of H']
    using of_circline_of_ocircline_pos_oriented [of "opposite_ocircline H'"]
    by auto
qed

(* -------------------------------------------------------------------------- *)
subsubsection ‹Set of points on oriented and unoriented circlines›
(* -------------------------------------------------------------------------- *)

lemma ocircline_set_of_circline [simp]:
  shows "ocircline_set (of_circline H) = circline_set H"
  unfolding ocircline_set_def circline_set_def
proof (safe)
  fix z
  assume "on_ocircline (of_circline H) z"
  thus "on_circline H z"
    by (transfer, transfer, simp del: on_circline_cmat_cvec_def opposite_ocircline_cmat_def split: if_split_asm)
next
  fix z
  assume "on_circline H z"
  thus "on_ocircline (of_circline H) z"
    by (transfer, transfer, simp del: on_circline_cmat_cvec_def opposite_ocircline_cmat_def split: if_split_asm)
qed

(* ----------------------------------------------------------------- *)
subsection ‹Some special oriented circlines and discs›
(* ----------------------------------------------------------------- *)

lift_definition mk_ocircline :: "complex  complex  complex  complex  ocircline" is mk_circline_clmat
  done

text ‹oriented unit circle and unit disc›

lift_definition ounit_circle :: "ocircline" is unit_circle_clmat
  done

lemma pos_oriented_ounit_circle [simp]: 
  shows "pos_oriented ounit_circle"
  by (transfer, transfer, simp)

lemma of_ocircline_ounit_circle [simp]:
  shows "of_ocircline ounit_circle = unit_circle"
  by (transfer, transfer, simp)

lemma of_circline_unit_circle [simp]:
  shows "of_circline (unit_circle) = ounit_circle"
  by (transfer, transfer, simp)

lemma ocircline_set_ounit_circle [simp]:
  shows "ocircline_set ounit_circle = circline_set unit_circle"
  apply (subst of_circline_unit_circle[symmetric])
  apply (subst ocircline_set_of_circline)
  apply simp
  done

definition unit_disc :: "complex_homo set" where
  "unit_disc = disc ounit_circle"

definition unit_disc_compl :: "complex_homo set" where
  "unit_disc_compl = disc_compl ounit_circle"

definition unit_circle_set :: "complex_homo set" where
  "unit_circle_set = circline_set unit_circle"

lemma zero_in_unit_disc [simp]:
  shows "0h  unit_disc"
  unfolding unit_disc_def disc_def
  by (simp, transfer, transfer) (simp add: Let_def vec_cnj_def)

lemma one_notin_unit_dic [simp]: 
  shows "1h  unit_disc"
  unfolding unit_disc_def disc_def
  by (simp, transfer, transfer) (simp add: Let_def vec_cnj_def)

lemma inf_notin_unit_disc [simp]:
  shows "h  unit_disc"
  unfolding unit_disc_def disc_def
  by (simp, transfer, transfer) (simp add: Let_def vec_cnj_def)

lemma unit_disc_iff_cmod_lt_1 [simp]:
  shows "of_complex c  unit_disc  cmod c < 1"
  unfolding unit_disc_def disc_def
  by (simp, transfer, transfer, simp add: vec_cnj_def cmod_def power2_eq_square)

lemma unit_disc_cmod_square_lt_1 [simp]:
  assumes "z  unit_disc"
  shows "(cmod (to_complex z))2 < 1"
  using assms inf_or_of_complex[of z]
  by (auto simp add: abs_square_less_1)

lemma unit_disc_to_complex_inj:
  assumes "u  unit_disc" and "v  unit_disc"
  assumes "to_complex u = to_complex v"
  shows "u = v"
  using assms
  using inf_or_of_complex[of u] inf_or_of_complex[of v]
  by auto

lemma inversion_unit_disc [simp]: 
  shows "inversion ` unit_disc = unit_disc_compl"
  unfolding unit_disc_def unit_disc_compl_def disc_def disc_compl_def
proof safe
  fix x
  assume "in_ocircline ounit_circle x"
  thus "out_ocircline ounit_circle (inversion x)"
    unfolding inversion_def
    by (transfer, transfer, auto simp add: vec_cnj_def)
next
  fix x
  assume *: "out_ocircline ounit_circle x"
  show "x  inversion ` Collect (in_ocircline ounit_circle)"
  proof (rule image_eqI)
    show "x = inversion (inversion x)"
      by auto
  next
    show "inversion x  Collect (in_ocircline ounit_circle)"
      using *
      unfolding inversion_def
      by (simp, transfer, transfer, auto simp add: vec_cnj_def)
  qed
qed

lemma inversion_unit_disc_compl [simp]: 
  shows "inversion ` unit_disc_compl = unit_disc"
proof-
  have "inversion ` (inversion ` unit_disc) = unit_disc"
    by (auto simp del: inversion_unit_disc simp add: image_iff)
  thus ?thesis
    by simp
qed

lemma inversion_noteq_unit_disc:
  assumes "u  unit_disc" and "v  unit_disc"
  shows "inversion u  v"
proof-
  from assms
  have "inversion u  unit_disc_compl"
    by (metis image_eqI inversion_unit_disc)
  thus ?thesis
    using assms
    unfolding unit_disc_def unit_disc_compl_def
    using disc_inter_disc_compl
    by fastforce
qed

lemma in_ocircline_ounit_circle_conjugate [simp]:
  assumes "in_ocircline ounit_circle z"
  shows "in_ocircline ounit_circle (conjugate z)"
  using assms
  by (transfer, transfer, auto simp add: vec_cnj_def)

lemma conjugate_unit_disc [simp]:
  shows "conjugate ` unit_disc = unit_disc"                
  unfolding unit_disc_def disc_def
  apply (auto simp add: image_iff)
  apply (rule_tac x="conjugate x" in exI, simp)
  done

lemma conjugate_in_unit_disc [simp]:
  assumes "z  unit_disc"
  shows "conjugate z  unit_disc"
  using conjugate_unit_disc
  using assms
  by blast

lemma out_ocircline_ounit_circle_conjugate [simp]:
  assumes "out_ocircline ounit_circle z"
  shows "out_ocircline ounit_circle (conjugate z)"
  using assms
  by (transfer, transfer, auto simp add: vec_cnj_def)

lemma conjugate_unit_disc_compl [simp]:
  shows "conjugate ` unit_disc_compl = unit_disc_compl"                
  unfolding unit_disc_compl_def disc_compl_def
  apply (auto simp add: image_iff)
  apply (rule_tac x="conjugate x" in exI, simp)
  done

lemma conjugate_in_unit_disc_compl [simp]:
  assumes "z  unit_disc_compl"
  shows "conjugate z  unit_disc_compl"
  using conjugate_unit_disc_compl
  using assms
  by blast

(* -------------------------------------------------------------------------- *)
subsubsection ‹Oriented x axis and lower half plane›
(* -------------------------------------------------------------------------- *)

lift_definition o_x_axis :: "ocircline" is x_axis_clmat
done

lemma o_x_axis_pos_oriented [simp]:
  shows "pos_oriented o_x_axis"
  by (transfer, transfer, simp)

lemma of_ocircline_o_x_axis [simp]: 
  shows "of_ocircline o_x_axis = x_axis"
  by (transfer, transfer, simp)

lemma of_circline_x_axis [simp]:
  shows "of_circline x_axis = o_x_axis"
  using of_circline_of_ocircline_pos_oriented[of o_x_axis]
  using o_x_axis_pos_oriented
  by simp

lemma ocircline_set_circline_set_x_axis [simp]: 
  shows "ocircline_set o_x_axis = circline_set x_axis"
  by (subst of_circline_x_axis[symmetric], subst ocircline_set_of_circline, simp)

lemma ii_in_disc_o_x_axis [simp]: 
  shows "iih  disc o_x_axis"
  unfolding disc_def
  by simp (transfer, transfer, simp add: Let_def vec_cnj_def)

lemma ii_notin_disc_o_x_axis [simp]:
  shows "iih  disc_compl o_x_axis"
  unfolding disc_compl_def
  by simp (transfer, transfer, simp add: Let_def vec_cnj_def)

lemma of_complex_in_o_x_axis_disc [simp]:
  shows "of_complex z  disc o_x_axis  Im z < 0"
  unfolding disc_def
  by auto (transfer, transfer, simp add: vec_cnj_def)+

lemma inf_notin_disc_o_x_axis [simp]:
  shows "h  disc o_x_axis"
  unfolding disc_def
  by simp (transfer, transfer, simp add: vec_cnj_def)

lemma disc_o_x_axis:
  shows "disc o_x_axis = of_complex ` {z. Im z < 0}"
proof-
  {
    fix z
    assume "z  disc o_x_axis"
    hence " x. Im x < 0  z = of_complex x"
      using inf_or_of_complex[of z]
      by auto
  }
  thus ?thesis
    by (auto simp add: image_iff)
qed

(* -------------------------------------------------------------------------- *)
subsubsection ‹Oriented single point circline›
(* -------------------------------------------------------------------------- *)

lift_definition  o_circline_point_0 :: "ocircline" is circline_point_0_clmat
done

lemma of_ocircline_o_circline_point_0 [simp]: 
  shows "of_ocircline o_circline_point_0 = circline_point_0"
  by (transfer, transfer, simp)

(* ----------------------------------------------------------------- *)
subsection ‹Möbius action on oriented circlines and discs›
(* ----------------------------------------------------------------- *)

text ‹Möbius action on an oriented circline is the same as on to an unoriented circline.›

lift_definition moebius_ocircline :: "moebius  ocircline  ocircline" is moebius_circline_mmat_clmat
  apply (transfer, transfer)
  apply simp
  apply ((erule exE)+, (erule conjE)+)
  apply (simp add: mat_inv_mult_sm)
  apply (rule_tac x="ka / Re (k * cnj k)" in exI, auto simp add: complex_mult_cnj_cmod power2_eq_square)
  done

text ‹Möbius action on (unoriented) circlines could have been defined using the action on oriented
circlines, but not the other way around.›

lemma moebius_circline_ocircline:
  shows "moebius_circline M H = of_ocircline (moebius_ocircline M (of_circline H))"
  apply (transfer, simp add: of_circline_clmat_def', safe)
  apply (transfer, simp, rule_tac x="-1" in exI, simp)
  done

lemma moebius_ocircline_circline:
  shows "moebius_ocircline M H = of_circline (moebius_circline M (of_ocircline H)) 
         moebius_ocircline M H = opposite_ocircline (of_circline (moebius_circline M (of_ocircline H)))"
  apply (transfer, simp add: of_circline_clmat_def', safe)
  apply (transfer, simp, rule_tac x="1" in exI, simp)
  apply (transfer, simp, erule_tac x="1" in allE, simp)
  done

text ‹Möbius action on oriented circlines have many nice properties as it was the case with
Möbius action on (unoriented) circlines. These transformations are injective and form group under
composition.›

lemma inj_moebius_ocircline [simp]:
  shows "inj (moebius_ocircline M)"
  unfolding inj_on_def
proof (safe)
  fix H H'
  assume "moebius_ocircline M H = moebius_ocircline M H'"
  thus "H = H'"
  proof (transfer, transfer)
    fix M H H' :: complex_mat
    assume "mat_det M  0"
    let ?iM = "mat_inv M"
    assume "ocircline_eq_cmat (moebius_circline_cmat_cmat M H) (moebius_circline_cmat_cmat M H')"
    then obtain k where "congruence ?iM H' = congruence ?iM (cor k *sm H)" "k > 0"
      by (auto simp del: congruence_def)
    thus "ocircline_eq_cmat H H'"
      using ‹mat_det M  0 inj_congruence[of ?iM H' "cor k *sm H"] mat_det_inv[of M]
      by auto
  qed
qed

lemma moebius_ocircline_id_moebius [simp]:
  shows "moebius_ocircline id_moebius H = H"
  by (transfer, transfer) (force simp add: mat_adj_def mat_cnj_def)

lemma moebius_ocircline_comp [simp]:
  shows "moebius_ocircline (moebius_comp M1 M2) H = moebius_ocircline M1 (moebius_ocircline M2 H)"
  by (transfer, transfer, simp, rule_tac x=1 in exI, simp add: mat_inv_mult_mm mult_mm_assoc)

lemma moebius_ocircline_comp_inv_left [simp]:
  shows "moebius_ocircline (moebius_inv M) (moebius_ocircline M H) = H"
  by (subst moebius_ocircline_comp[symmetric]) simp

lemma moebius_ocircline_comp_inv_right [simp]:
  shows "moebius_ocircline M (moebius_ocircline (moebius_inv M) H) = H"
  by (subst moebius_ocircline_comp[symmetric]) simp

lemma moebius_ocircline_opposite_ocircline [simp]:
  shows "moebius_ocircline M (opposite_ocircline H) = opposite_ocircline (moebius_ocircline M H)"
  by (transfer, transfer, simp, rule_tac x=1 in exI, simp)

text ‹Möbius action on oriented circlines preserve the set of points of the circline.›

lemma ocircline_set_moebius_ocircline [simp]:
  shows "ocircline_set (moebius_ocircline M H) = moebius_pt M ` ocircline_set H" (is "?lhs = ?rhs")
proof-
  have "?rhs = circline_set (moebius_circline M (of_ocircline H))"
    by simp
  thus ?thesis
    using moebius_ocircline_circline[of M H]
    by auto
qed

lemma ocircline_set_fix_iff_ocircline_fix:
  assumes "ocircline_set H'  {}"
  shows "ocircline_set (moebius_ocircline M H) = ocircline_set H' 
         moebius_ocircline M H = H'  moebius_ocircline M H = opposite_ocircline H'"
  using assms
  using inj_ocircline_set[of "moebius_ocircline M H" H']
  by (auto simp del: ocircline_set_moebius_ocircline)

lemma disc_moebius_ocircline [simp]:
  shows "disc (moebius_ocircline M H) = moebius_pt M ` (disc H)"
proof (safe)
  fix z
  assume "z  disc H"
  thus "moebius_pt M z  disc (moebius_ocircline M H)"
    unfolding disc_def
  proof (safe)
    assume "in_ocircline H z"
    thus "in_ocircline (moebius_ocircline M H) (moebius_pt M z)"
    proof (transfer, transfer)
      fix H M :: complex_mat and z :: complex_vec
      assume "mat_det M  0"
      assume "in_ocircline_cmat_cvec H z"
      thus "in_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) (moebius_pt_cmat_cvec M z)"
        using ‹mat_det M  0 quad_form_congruence[of M z]
        by simp
    qed
  qed
next
  fix z
  assume "z  disc (moebius_ocircline M H)"
  thus "z  moebius_pt M ` disc H"
    unfolding disc_def
  proof(safe)
    assume "in_ocircline (moebius_ocircline M H) z"
    show "z  moebius_pt M ` Collect (in_ocircline H)"
    proof
      show "z = moebius_pt M (moebius_pt (moebius_inv M) z)"
        by simp
    next
      show "moebius_pt (moebius_inv M) z  Collect (in_ocircline H)"
        using ‹in_ocircline (moebius_ocircline M H) z
      proof (safe, transfer, transfer)
        fix M H :: complex_mat and z :: complex_vec
        assume "mat_det M  0"
        hence "congruence (mat_inv (mat_inv M)) (congruence (mat_inv M) H) = H"
          by (simp del: congruence_def)
        hence "quad_form z (congruence (mat_inv M) H) = quad_form (mat_inv M *mv z) H"
          using quad_form_congruence[of "mat_inv M" "z" "congruence (mat_inv M) H"]
          using ‹mat_det M  0 mat_det_inv[of "M"]
          by simp
        moreover
        assume "in_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) z"
        ultimately
        show "in_ocircline_cmat_cvec H (moebius_pt_cmat_cvec (moebius_inv_cmat M) z)"
          by simp
      qed
    qed
  qed
qed

lemma disc_compl_moebius_ocircline [simp]:
  shows "disc_compl (moebius_ocircline M H) = moebius_pt M ` (disc_compl H)"
proof (safe)
  fix z
  assume "z  disc_compl H"
  thus "moebius_pt M z  disc_compl (moebius_ocircline M H)"
    unfolding disc_compl_def
  proof (safe)
    assume "out_ocircline H z"
    thus "out_ocircline (moebius_ocircline M H) (moebius_pt M z)"
    proof (transfer, transfer)
      fix H M :: complex_mat and z :: complex_vec
      assume "mat_det M  0"
      assume "out_ocircline_cmat_cvec H z"
      thus "out_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) (moebius_pt_cmat_cvec M z)"
        using ‹mat_det M  0 quad_form_congruence[of M z]
        by simp
    qed
  qed
next
  fix z
  assume "z  disc_compl (moebius_ocircline M H)"
  thus "z  moebius_pt M ` disc_compl H"
    unfolding disc_compl_def
  proof(safe)
    assume "out_ocircline (moebius_ocircline M H) z"
    show "z  moebius_pt M ` Collect (out_ocircline H)"
    proof
      show "z = moebius_pt M (moebius_pt (moebius_inv M) z)"
        by simp
    next
      show "moebius_pt (moebius_inv M) z  Collect (out_ocircline H)"
        using ‹out_ocircline (moebius_ocircline M H) z
      proof (safe, transfer, transfer)
        fix M H :: complex_mat and z :: complex_vec
        assume "mat_det M  0"
        hence "congruence (mat_inv (mat_inv M)) (congruence (mat_inv M) H) = H"
          by (simp del: congruence_def)
        hence "quad_form z (congruence (mat_inv M) H) = quad_form (mat_inv M *mv z) H"
          using quad_form_congruence[of "mat_inv M" "z" "congruence (mat_inv M) H"]
          using ‹mat_det M  0 mat_det_inv[of "M"]
          by simp
        moreover
        assume "out_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) z"
        ultimately
        show "out_ocircline_cmat_cvec H (moebius_pt_cmat_cvec (moebius_inv_cmat M) z)"
          by simp
      qed
    qed
  qed
qed

(* ----------------------------------------------------------------- *)
subsection ‹Orientation after Möbius transformations›
(* ----------------------------------------------------------------- *)

text ‹All Euclidean similarities preserve circline orientation.›

lemma moebius_similarity_oriented_lines_to_oriented_lines:
  assumes "a  0"
  shows "h  ocircline_set H  h  ocircline_set (moebius_ocircline (moebius_similarity a b) H)"
  using moebius_similarity_lines_to_lines[OF a  0, of b "of_ocircline H"]
  by simp

lemma moebius_similarity_preserve_orientation':
  assumes "a  0" and "h  ocircline_set H" and "pos_oriented H"
  shows "pos_oriented (moebius_ocircline (moebius_similarity a b) H)"
proof-
  let ?M = "moebius_similarity a b"
  let ?H = "moebius_ocircline ?M H"
  have "h  ocircline_set ?H"
    using h  ocircline_set H moebius_similarity_oriented_lines_to_oriented_lines[OF a  0]
    by simp

  have "h  disc_compl H"
    using h  ocircline_set H ‹pos_oriented H pos_oriented_circle_inf[of H] in_on_out
    unfolding disc_def disc_compl_def ocircline_set_def
    by auto
  hence "h  disc_compl ?H"
    using moebius_similarity_inf[OF a  0, of b]
    by force
  thus "pos_oriented ?H"
    using pos_oriented_circle_inf[of ?H] disc_inter_disc_compl[of ?H] h  ocircline_set ?H
    by auto
qed

lemma moebius_similarity_preserve_orientation:
  assumes "a  0" and "h  ocircline_set H"
  shows "pos_oriented H  pos_oriented(moebius_ocircline (moebius_similarity a b) H)"
proof-
  let ?M = "moebius_similarity a b"
  let ?H = "moebius_ocircline ?M H"
  have "h  ocircline_set ?H"
    using h  ocircline_set H moebius_similarity_oriented_lines_to_oriented_lines[OF a  0]
    by simp

  have *: "H = moebius_ocircline (- moebius_similarity a b) ?H"
    by simp
  show ?thesis
    using a  0
    using moebius_similarity_preserve_orientation' [OF a  0 h  ocircline_set H]
    using moebius_similarity_preserve_orientation'[OF _   h  ocircline_set ?H, of "1/a" "-b/a"]
    using moebius_similarity_inv[of a b, OF a  0]  *
    by auto
qed

lemma reciprocal_preserve_orientation:
  assumes "0h  disc_compl H"
  shows "pos_oriented (moebius_ocircline moebius_reciprocal H)"
proof-
  have "h  disc_compl (moebius_ocircline moebius_reciprocal H)"
    using assms
    by force
  thus "pos_oriented (moebius_ocircline moebius_reciprocal H)"
    using pos_oriented_circle_inf[of "moebius_ocircline moebius_reciprocal H"]
    using disc_inter_disc_compl[of "moebius_ocircline moebius_reciprocal H"]
    using disc_compl_inter_ocircline_set[of "moebius_ocircline moebius_reciprocal H"]
    by auto
qed


lemma reciprocal_not_preserve_orientation:
  assumes "0h  disc H"
  shows "¬ pos_oriented (moebius_ocircline moebius_reciprocal H)"
proof-
  let ?H = "moebius_ocircline moebius_reciprocal H"
  have "h  disc ?H"
    using assms
    by force
  thus "¬ pos_oriented ?H"
    using pos_oriented_circle_inf[of ?H] disc_inter_ocircline_set[of ?H]
    by auto
qed

text ‹Orientation of the image of a given oriented circline $H$ under a given Möbius transformation
$M$ depends on whether the pole of $M$ (the point that $M$ maps to $\infty_{hc}$) lies in the disc
or in the disc complement of $H$ (if it is on the set of $H$, then it maps onto a line and we do not
discuss the orientation).›

lemma pole_in_disc:
  assumes "M = mk_moebius a b c d" and "c  0" and "a*d - b*c  0"
  assumes "is_pole M z" "z  disc H"
  shows "¬ pos_oriented (moebius_ocircline M H)"
proof-
  let ?t1 = "moebius_translation (a / c)"
  let ?rd = "moebius_rotation_dilatation ((b * c - a * d) / (c * c))"
  let ?r =  "moebius_reciprocal"
  let ?t2 = "moebius_translation (d / c)"

  have "0h = moebius_pt (moebius_translation (d/c)) z"
    using pole_mk_moebius[of a b c d z] assms
    by simp

  have "z  ocircline_set H"
    using z  disc H disc_inter_ocircline_set[of H]
    by blast      
                                              
  hence "0h  ocircline_set (moebius_ocircline ?t2 H)"
    using 0h = moebius_pt ?t2 z
    using moebius_pt_neq_I[of z _ ?t2]
    by force

  hence *: "h  ocircline_set (moebius_ocircline (?r + ?t2) H)"
    using 0h = moebius_pt (moebius_translation (d / c)) z
    by (metis circline_set_moebius_circline circline_set_moebius_circline_iff circline_set_of_ocircline moebius_pt_comp moebius_reciprocal ocircline_set_moebius_ocircline plus_moebius_def reciprocal_zero)

    
  hence **: "h  ocircline_set (moebius_ocircline (?rd + ?r + ?t2) H)"
    using a*d - b*c  0 c  0
    unfolding moebius_rotation_dilatation_def
    using moebius_similarity_oriented_lines_to_oriented_lines[of _ "moebius_ocircline (?r + ?t2) H"]
    by (metis divide_eq_0_iff divisors_zero moebius_ocircline_comp plus_moebius_def right_minus_eq)

  have "¬ pos_oriented (moebius_ocircline (?r + ?t2) H)"
    using pole_mk_moebius[of a b c d z] assms
    using reciprocal_not_preserve_orientation
    by force
  hence "¬ pos_oriented (moebius_ocircline (?rd + ?r + ?t2) H)"
    using *
    using a*d - b*c  0 c  0
    using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?r + ?t2) H"]
    unfolding moebius_rotation_dilatation_def
    by simp    
  hence "¬ pos_oriented (moebius_ocircline (?t1 + ?rd + ?r + ?t2) H)"
    using **
    using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?rd + ?r + ?t2) H"]
    unfolding moebius_translation_def
    by simp

  thus ?thesis
    using assms
    by simp (subst moebius_decomposition, simp_all)
qed

lemma pole_in_disc_compl:
  assumes "M = mk_moebius a b c d" and "c  0" and "a*d - b*c  0"
  assumes "is_pole M z" and "z  disc_compl H"
  shows "pos_oriented (moebius_ocircline M H)"
proof-
  let ?t1 = "moebius_translation (a / c)"
  let ?rd = "moebius_rotation_dilatation ((b * c - a * d) / (c * c))"
  let ?r = "moebius_reciprocal"
  let ?t2 = "moebius_translation (d / c)"

  have "0h = moebius_pt (moebius_translation (d/c)) z"
    using pole_mk_moebius[of a b c d z] assms
    by simp

  have "z  ocircline_set H"
    using z  disc_compl H disc_compl_inter_ocircline_set[of H]
    by blast
  hence "0h  ocircline_set (moebius_ocircline ?t2 H)"
    using 0h = moebius_pt ?t2 z
    using moebius_pt_neq_I[of z _ ?t2]
    by force
  hence *: "h  ocircline_set (moebius_ocircline (?r + ?t2) H)"
    using 0h = moebius_pt (moebius_translation (d / c)) z 
    by (metis circline_set_moebius_circline circline_set_moebius_circline_iff circline_set_of_ocircline moebius_pt_comp moebius_reciprocal ocircline_set_moebius_ocircline plus_moebius_def reciprocal_zero)

  hence **: "h  ocircline_set (moebius_ocircline (?rd + ?r + ?t2) H)"
    using a*d - b*c  0 c  0
    unfolding moebius_rotation_dilatation_def
    using moebius_similarity_oriented_lines_to_oriented_lines[of _ "moebius_ocircline (?r + ?t2) H"]
    by (metis divide_eq_0_iff divisors_zero moebius_ocircline_comp plus_moebius_def right_minus_eq)

  have "pos_oriented (moebius_ocircline (?r + ?t2) H)"
    using pole_mk_moebius[of a b c d z] assms
    using reciprocal_preserve_orientation
    by force
  hence "pos_oriented (moebius_ocircline (?rd + ?r + ?t2) H)"
    using *
    using a*d - b*c  0 c  0
    using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?r + ?t2) H"]
    unfolding moebius_rotation_dilatation_def
    by simp
  hence "pos_oriented (moebius_ocircline (?t1 + ?rd + ?r + ?t2) H)"
    using **
    using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?rd + ?r + ?t2) H"]
    unfolding moebius_translation_def
    by simp

  thus ?thesis
    using assms
    by simp (subst moebius_decomposition, simp_all)
qed

(* ----------------------------------------------------------------- *)
subsection ‹Oriented circlines uniqueness›
(* ----------------------------------------------------------------- *)

lemma ocircline_01inf:
  assumes "0h  ocircline_set H  1h  ocircline_set H  h  ocircline_set H"
  shows "H = o_x_axis  H = opposite_ocircline o_x_axis"
proof-
  have "0h  circline_set (of_ocircline H)  1h  circline_set (of_ocircline H)  h  circline_set (of_ocircline H)"
    using assms
    by simp
  hence "of_ocircline H = x_axis"
    using unique_circline_01inf'
    by auto
  thus "H = o_x_axis  H = opposite_ocircline o_x_axis"
    by (metis inj_of_ocircline of_ocircline_o_x_axis)
qed

lemma unique_ocircline_01inf:
  shows "∃! H. 0h  ocircline_set H  1h  ocircline_set H  h  ocircline_set H  iih  disc H"
proof
  show "0h  ocircline_set o_x_axis  1h  ocircline_set o_x_axis  h  ocircline_set o_x_axis  iih  disc o_x_axis"
    by simp
next
  fix H
  assume "0h  ocircline_set H  1h  ocircline_set H  h  ocircline_set H  iih  disc H"
  hence "0h  ocircline_set H  1h  ocircline_set H  h  ocircline_set H" "iih  disc H"
    by auto
  hence "H = o_x_axis  H = opposite_ocircline o_x_axis"
    using ocircline_01inf
    by simp
  thus "H = o_x_axis"           
    using iih  disc H
    by auto
qed

lemma unique_ocircline_set:
  assumes "A  B" and "A  C" and "B  C"
  shows "∃! H. pos_oriented H  (A  ocircline_set H  B  ocircline_set H  C  ocircline_set H)"
proof-
  obtain M where *: "moebius_pt M A = 0h"  "moebius_pt M B = 1h" "moebius_pt M C = h"
    using ex_moebius_01inf[OF assms]
    by auto
  let ?iM = "moebius_pt (moebius_inv M)"
  have **: "?iM 0h = A"  "?iM 1h = B"  "?iM h = C"
    using *
    by (auto simp add: moebius_pt_invert)
  let ?H = "moebius_ocircline (moebius_inv M) o_x_axis"
  have 1: "A  ocircline_set ?H" "B  ocircline_set ?H" "C  ocircline_set ?H"
    using **
    by auto
  have 2: " H'. A  ocircline_set H'  B  ocircline_set H'  C  ocircline_set H'  H' = ?H  H' = opposite_ocircline ?H"
  proof-
    fix H'
    let ?H' = "ocircline_set H'" and ?H'' = "ocircline_set (moebius_ocircline M H')"
    assume "A  ocircline_set H'  B  ocircline_set H'  C  ocircline_set H'"
    hence "moebius_pt M A  ?H''" "moebius_pt M B  ?H''" "moebius_pt M C  ?H''"
      by auto
    hence "0h  ?H''" "1h  ?H''"  "h  ?H''"
      using *
      by auto
    hence "moebius_ocircline M H' = o_x_axis  moebius_ocircline M H' = opposite_ocircline o_x_axis"
      using ocircline_01inf
      by auto
    hence "o_x_axis = moebius_ocircline M H'   o_x_axis = opposite_ocircline (moebius_ocircline M H')"
      by auto
    thus "H' = ?H  H' = opposite_ocircline ?H"
    proof
      assume *: "o_x_axis = moebius_ocircline M H'"
      show "H' = moebius_ocircline (moebius_inv M) o_x_axis  H' = opposite_ocircline (moebius_ocircline (moebius_inv M) o_x_axis)"
        by (rule disjI1) (subst *, simp)
    next
      assume *: "o_x_axis = opposite_ocircline (moebius_ocircline M H')"
      show "H' = moebius_ocircline (moebius_inv M) o_x_axis  H' = opposite_ocircline (moebius_ocircline (moebius_inv M) o_x_axis)"
        by (rule disjI2) (subst *, simp)
    qed
  qed

  show ?thesis (is "∃! x. ?P x")
  proof (cases "pos_oriented ?H")
    case True
    show ?thesis
    proof
      show "?P ?H"
        using 1 True
        by auto
    next
      fix H
      assume "?P H"
      thus "H = ?H"
        using 1 2[of H] True
        by auto
    qed
  next
    case False
    let ?OH = "opposite_ocircline ?H"
    show ?thesis
    proof
      show "?P ?OH"
        using 1 False
        by auto
    next
      fix H
      assume "?P H"
      thus "H = ?OH"
        using False 2[of H]
        by auto
    qed
  qed
qed

lemma ocircline_set_0h:
  assumes "ocircline_set H = {0h}"
  shows "H = o_circline_point_0  H = opposite_ocircline (o_circline_point_0)"
proof-
  have "of_ocircline H = circline_point_0"
    using assms
    using unique_circline_type_zero_0' card_eq1_circline_type_zero[of "of_ocircline H"]
    by auto
  thus ?thesis
    by (metis inj_of_ocircline of_ocircline_o_circline_point_0)
qed


end

Theory Circlines_Angle

theory Circlines_Angle
  imports Oriented_Circlines Elementary_Complex_Geometry
begin


(* ----------------------------------------------------------------- *)
subsection ‹Angle between circlines›
(* ----------------------------------------------------------------- *)

text ‹Angle between circlines can be defined in purely algebraic terms (following Schwerdtfeger
\cite{schwerdtfeger}) and using this definitions many properties can be easily proved.›

fun mat_det_12 :: "complex_mat  complex_mat  complex" where
  "mat_det_12 (A1, B1, C1, D1) (A2, B2, C2, D2) = A1*D2 + A2*D1 - B1*C2 - B2*C1"

lemma mat_det_12_mm_l [simp]:
  shows "mat_det_12 (M *mm A) (M *mm B) = mat_det M * mat_det_12 A B"
  by (cases M, cases A, cases B) (simp add: field_simps)

lemma mat_det_12_mm_r [simp]:
  shows "mat_det_12 (A *mm M) (B *mm M) = mat_det M * mat_det_12 A B"
  by (cases M, cases A, cases B) (simp add: field_simps)

lemma mat_det_12_sm_l [simp]:
  shows "mat_det_12 (k *sm A) B = k * mat_det_12 A B"
  by (cases A, cases B) (simp add: field_simps)

lemma mat_det_12_sm_r [simp]:
  shows "mat_det_12 A (k *sm B) = k * mat_det_12 A B"
  by (cases A, cases B) (simp add: field_simps)

lemma mat_det_12_congruence [simp]:
  shows "mat_det_12 (congruence M A) (congruence M B) = (cor ((cmod (mat_det M))2)) * mat_det_12 A B"
  unfolding congruence_def
  by ((subst mult_mm_assoc[symmetric])+, subst mat_det_12_mm_l, subst mat_det_12_mm_r, subst mat_det_adj) (auto simp add: field_simps complex_mult_cnj_cmod)


definition cos_angle_cmat :: "complex_mat  complex_mat  real" where
  [simp]: "cos_angle_cmat H1 H2 = - Re (mat_det_12 H1 H2) / (2 * (sqrt (Re (mat_det H1 * mat_det H2))))"

lift_definition cos_angle_clmat :: "circline_mat  circline_mat  real" is cos_angle_cmat
  done

lemma cos_angle_den_scale [simp]:
  assumes "k1 > 0" and "k2 > 0"
  shows "sqrt (Re ((k12 * mat_det H1) * (k22 * mat_det H2))) =
         k1 * k2 * sqrt (Re (mat_det H1 * mat_det H2))"
proof-
  let ?lhs = "(k12 * mat_det H1) * (k22 * mat_det H2)"
  let ?rhs = "mat_det H1 * mat_det H2"
  have 1: "?lhs = (k12*k22) * ?rhs"
    by simp
  hence "Re ?lhs = (k12*k22) * Re ?rhs"
    by (simp add: field_simps)
  thus ?thesis
    using assms
    by (simp add: real_sqrt_mult)
qed

lift_definition cos_angle :: "ocircline  ocircline  real" is cos_angle_clmat
proof transfer
  fix H1 H2 H1' H2'
  assume "ocircline_eq_cmat H1 H1'" "ocircline_eq_cmat H2 H2'"
  then obtain k1 k2 :: real where
  *:  "k1 > 0" "H1' = cor k1 *sm H1"
      "k2 > 0" "H2' = cor k2 *sm H2"
    by auto
  thus "cos_angle_cmat H1 H2 = cos_angle_cmat H1' H2'"
    unfolding cos_angle_cmat_def
    apply (subst *)+
    apply (subst mat_det_12_sm_l, subst mat_det_12_sm_r)
    apply (subst mat_det_mult_sm)+
    apply (subst power2_eq_square[symmetric])+
    apply (subst cos_angle_den_scale, simp, simp)
    apply simp
    done
qed

text ‹Möbius transformations are conformal, meaning that they preserve oriented angle between
oriented circlines.›

lemma cos_angle_opposite1 [simp]: 
  shows "cos_angle (opposite_ocircline H) H' = - cos_angle H H'"
  by (transfer, transfer, simp)

lemma cos_angle_opposite2 [simp]: 
  shows "cos_angle H (opposite_ocircline H') = - cos_angle H H'"
  by (transfer, transfer, simp)

(* ----------------------------------------------------------------- *)
subsubsection ‹Connection with the elementary angle definition between circles›
(* ----------------------------------------------------------------- *)

text‹We want to connect algebraic definition of an angle with a traditional one and 
to prove equivalency between these two definitions. For the traditional definition of 
an angle we follow the approach suggested by Needham \cite{needham}.›

lemma Re_sgn:
  assumes "is_real A" and "A  0"
  shows "Re (sgn A) = sgn_bool (Re A > 0)"
using assms
using More_Complex.Re_sgn complex_eq_if_Re_eq
by auto

lemma Re_mult_real3:
  assumes "is_real z1" and "is_real z2" and "is_real z3"
  shows "Re (z1 * z2 * z3) = Re z1 * Re z2 * Re z3"
  using assms
  by (metis Re_mult_real mult_reals)

lemma sgn_sqrt [simp]: 
  shows "sgn (sqrt x) = sgn x"
  by (simp add: sgn_root sqrt_def)

lemma real_circle_sgn_r:
  assumes "is_circle H" and "(a, r) = euclidean_circle H"
  shows "sgn r = - circline_type H"
  using assms
proof (transfer, transfer)
  fix H :: complex_mat and a r
  assume hh: "hermitean H  H  mat_zero"
  obtain A B C D where HH: "H = (A, B, C, D)"
    by (cases H) auto
  hence "is_real A" "is_real D"
    using hermitean_elems hh
    by auto
  assume "¬ circline_A0_cmat H" "(a, r) = euclidean_circle_cmat H"
  hence "A  0"
    using ¬ circline_A0_cmat H HH
    by simp
  hence "Re A * Re A > 0"
    using ‹is_real A
    using complex_eq_if_Re_eq not_real_square_gt_zero
    by fastforce
  thus "sgn r = - circline_type_cmat H"
    using HH (a, r) = euclidean_circle_cmat H ‹is_real A ‹is_real D A  0
    by (simp add: Re_divide_real sgn_minus[symmetric])
qed

text ‹The definition of an angle using algebraic terms is not intuitive, and we want to connect it to
the more common definition given earlier that defines an
angle between circlines as the angle between tangent vectors in the point of the intersection of the
circlines.›

lemma cos_angle_eq_cos_ang_circ:
  assumes
  "is_circle (of_ocircline H1)" and "is_circle (of_ocircline H2)" and
  "circline_type (of_ocircline H1) < 0" and "circline_type (of_ocircline H2) < 0"
  "(a1, r1) = euclidean_circle (of_ocircline H1)" and "(a2, r2) = euclidean_circle (of_ocircline H2)" and
  "of_complex E  ocircline_set H1  ocircline_set H2"
  shows "cos_angle H1 H2 = cos (ang_circ E a1 a2 (pos_oriented H1) (pos_oriented H2))"
proof-
  let ?p1 = "pos_oriented H1" and ?p2 = "pos_oriented H2"
  have "E  circle a1 r1" "E  circle a2 r2"
    using classic_circle[of "of_ocircline H1" a1 r1]  classic_circle[of "of_ocircline H2" a2 r2]
    using assms of_complex_inj
    by auto
  hence *: "cdist E a1 = r1" "cdist E a2 = r2"
    unfolding circle_def
    by (simp_all add: norm_minus_commute)
  have "r1 > 0" "r2 > 0"
    using assms(1-6) real_circle_sgn_r[of "of_ocircline H1" a1 r1]  real_circle_sgn_r[of "of_ocircline H2" a2 r2]
    using sgn_greater 
    by fastforce+
  hence "E  a1" "E  a2"
    using ‹cdist E a1 = r1 ‹cdist E a2 = r2
    by auto

  let ?k = "sgn_bool (?p1 = ?p2)"
  let ?xx = "?k * (r12 + r22 - (cdist a2 a1)2) / (2 * r1 * r2)"

  have "cos (ang_circ E a1 a2 ?p1 ?p2) = ?xx"
    using law_of_cosines[of a2 a1 E] * r1 > 0 r2 > 0 cos_ang_circ_simp[OF E  a1 E  a2]
    by (subst (asm) ang_vec_opposite_opposite'[OF E  a1[symmetric] E  a2[symmetric], symmetric]) simp
  moreover
  have "cos_angle H1 H2 = ?xx"
    using r1 > 0 r2 > 0
    using (a1, r1) = euclidean_circle (of_ocircline H1) (a2, r2) = euclidean_circle (of_ocircline H2)
    using ‹is_circle (of_ocircline H1) ‹is_circle (of_ocircline H2)
    using ‹circline_type (of_ocircline H1) < 0 ‹circline_type (of_ocircline H2) < 0
  proof (transfer, transfer)
    fix a1 r1 H1 H2 a2 r2
    assume hh: "hermitean H1  H1  mat_zero" "hermitean H2  H2  mat_zero"
    obtain A1 B1 C1 D1 where HH1: "H1 = (A1, B1, C1, D1)"
      by (cases H1) auto
    obtain A2 B2 C2 D2 where HH2: "H2 = (A2, B2, C2, D2)"
      by (cases H2) auto
    have *: "is_real A1" "is_real A2" "is_real D1" "is_real D2" "cnj B1 = C1" "cnj B2 = C2"
      using hh hermitean_elems[of A1 B1 C1 D1] hermitean_elems[of A2 B2 C2 D2] HH1 HH2
      by auto
    have "cnj A1 = A1" "cnj A2 = A2"
      using ‹is_real A1 ‹is_real A2
      by (case_tac[!] A1, case_tac[!] A2, auto simp add: Complex_eq)

    assume "¬ circline_A0_cmat (id H1)" "¬ circline_A0_cmat (id H2)"
    hence "A1  0" "A2  0"
      using HH1 HH2
      by auto
    hence "Re A1  0" "Re A2  0"
      using ‹is_real A1 ‹is_real A2
      using complex.expand
      by auto

    assume "circline_type_cmat (id H1) < 0" "circline_type_cmat (id H2) < 0"
    assume "(a1, r1) = euclidean_circle_cmat (id H1)" "(a2, r2) = euclidean_circle_cmat (id H2)"
    assume "r1 > 0" "r2 > 0"

    let ?D12 = "mat_det_12 H1 H2" and ?D1 = "mat_det H1" and ?D2 = "mat_det H2"
    let ?x1 = "(cdist a2 a1)2 - r12 - r22" and ?x2 = "2*r1*r2"
    let ?x = "?x1 / ?x2"
    have *:  "Re (?D12) / (2 * (sqrt (Re (?D1 * ?D2)))) = Re (sgn A1) * Re (sgn A2) * ?x"
    proof-
      let ?M1 = "(A1, B1, C1, D1)" and ?M2 = "(A2, B2, C2, D2)"
      let ?d1 = "B1 * C1 - A1 * D1" and ?d2 = "B2 * C2 - A2 * D2"
      have "Re ?d1 > 0" "Re ?d2 > 0"
        using HH1 HH2 ‹circline_type_cmat (id H1) < 0  ‹circline_type_cmat (id H2) < 0
        by auto
      hence **: "Re (?d1 / (A1 * A1)) > 0" "Re (?d2 / (A2 * A2)) > 0"
        using ‹is_real A1 ‹is_real A2 A1  0 A2  0
        by (subst Re_divide_real, simp_all add: complex_neq_0 power2_eq_square)+
      have ***: "is_real (?d1 / (A1 * A1))  is_real (?d2 / (A2 * A2))"
        using ‹is_real A1  ‹is_real A2 A1  0 A2  0 ‹cnj B1 = C1[symmetric] ‹cnj B2 = C2[symmetric] ‹is_real D1 ‹is_real D2
        by (subst div_reals, simp, simp, simp)+

      have "cor ?x = mat_det_12 ?M1 ?M2 / (2 * sgn A1 * sgn A2 * cor (sqrt (Re ?d1) * sqrt (Re ?d2)))"
      proof-
        have "A1*A2*cor ?x1 = mat_det_12 ?M1 ?M2"
        proof-
          have 1: "A1*A2*(cor ((cdist a2 a1)2)) = ((B2*A1 - A2*B1)*(C2*A1 - C1*A2)) / (A1*A2)"
            using (a1, r1) = euclidean_circle_cmat (id H1) (a2, r2) = euclidean_circle_cmat (id H2)
            unfolding cdist_def cmod_square
            using HH1 HH2 * A1  0 A2  0 ‹cnj A1 = A1 ‹cnj A2 = A2
            unfolding Let_def
            apply (subst complex_of_real_Re)
            apply (simp add: field_simps)
            apply (simp add: complex_mult_cnj_cmod power2_eq_square)
            apply (simp add: field_simps)
            done
          have 2: "A1*A2*cor (-r12) = A2*D1 - B1*C1*A2/A1"
            using (a1, r1) = euclidean_circle_cmat (id H1)
            using HH1 ** * *** A1  0
            by (simp add: power2_eq_square field_simps)
          have 3: "A1*A2*cor (-r22) = A1*D2 - B2*C2*A1/A2"
            using (a2, r2) = euclidean_circle_cmat (id H2)
            using HH2 ** * *** A2  0
            by (simp add: power2_eq_square field_simps)
          have "A1*A2*cor((cdist a2 a1)2) + A1*A2*cor(-r12) + A1*A2*cor(-r22) = mat_det_12 ?M1 ?M2"
            using A1  0 A2  0
            by (subst 1, subst 2, subst 3) (simp add: field_simps)
          thus ?thesis
            by (simp add: field_simps)
        qed

        moreover

        have "A1 * A2 * cor (?x2) = 2 * sgn A1 * sgn A2 * cor (sqrt (Re ?d1) * sqrt (Re ?d2))"
        proof-
          have 1: "sqrt (Re (?d1/ (A1 * A1))) = sqrt (Re ?d1) / ¦Re A1¦"
            using A1  0 ‹is_real A1
            by (subst Re_divide_real, simp, simp, subst real_sqrt_divide, simp)

          have 2: "sqrt (Re (?d2/ (A2 * A2))) = sqrt (Re ?d2) / ¦Re A2¦"
            using A2  0 ‹is_real A2
            by (subst Re_divide_real, simp, simp, subst real_sqrt_divide, simp)
          have "sgn A1 = A1 / cor ¦Re A1¦"
            using ‹is_real A1
            unfolding sgn_eq
            by (simp add: cmod_eq_Re)
          moreover
          have "sgn A2 = A2 / cor ¦Re A2¦"
            using ‹is_real A2
            unfolding sgn_eq
            by (simp add: cmod_eq_Re)
          ultimately
          show ?thesis
            using (a1, r1) = euclidean_circle_cmat (id H1) (a2, r2) = euclidean_circle_cmat (id H2)  HH1 HH2
            using *** ‹is_real A1 ‹is_real A2
            by simp (subst 1, subst 2, simp)
        qed

        ultimately

        have "(A1 * A2 * cor ?x1) / (A1 * A2 * (cor ?x2)) =
               mat_det_12 ?M1 ?M2 / (2 * sgn A1 * sgn A2 * cor (sqrt (Re ?d1) * sqrt (Re ?d2)))"
          by simp
        thus ?thesis
          using A1  0 A2  0
          by simp
      qed
      hence "cor ?x * sgn A1 * sgn A2 = mat_det_12 ?M1 ?M2 / (2 * cor (sqrt (Re ?d1) * sqrt (Re ?d2)))"
        using A1  0 A2  0
        by (simp add: sgn_zero_iff)
      moreover
      have "Re (cor ?x * sgn A1 * sgn A2) = Re (sgn A1) * Re (sgn A2) * ?x"
      proof-
        have "is_real (cor ?x)" "is_real (sgn A1)" "is_real (sgn A2)"
          using ‹is_real A1 ‹is_real A2 Im_complex_of_real[of ?x]
          by auto
        thus ?thesis
          using Re_complex_of_real[of ?x]
          by (subst Re_mult_real3, auto simp add: field_simps)
      qed
      moreover
      have *: "sqrt (Re ?D1) * sqrt (Re ?D2) = sqrt (Re ?d1) * sqrt (Re ?d2)"
        using HH1 HH2
        by (subst real_sqrt_mult[symmetric])+ (simp add: field_simps)
      have "2 * (sqrt (Re (?D1 * ?D2)))  0"
        using ‹Re ?d1 > 0  ‹Re ?d2 > 0 HH1 HH2 ‹is_real A1 ‹is_real A2  ‹is_real D1 ‹is_real D2
        using hh mat_det_hermitean_real[of "H1"]
        by (subst Re_mult_real, auto)
      hence **: "Re (?D12 / (2 * cor (sqrt (Re (?D1 * ?D2))))) = Re (?D12) / (2 * (sqrt (Re (?D1 * ?D2))))"
        using ‹Re ?d1 > 0  ‹Re ?d2 > 0 HH1 HH2 ‹is_real A1 ‹is_real A2  ‹is_real D1 ‹is_real D2
        by (subst Re_divide_real) auto
      have "Re (mat_det_12 ?M1 ?M2 / (2 * cor (sqrt (Re ?d1) * sqrt (Re ?d2)))) = Re (?D12) / (2 * (sqrt (Re (?D1 * ?D2))))"
        using HH1 HH2 hh mat_det_hermitean_real[of "H1"]
        by (subst **[symmetric], subst Re_mult_real, simp, subst real_sqrt_mult, subst *, simp)
      ultimately
      show ?thesis
        by simp
    qed
    have **: "pos_oriented_cmat H1  Re A1 > 0"  "pos_oriented_cmat H2  Re A2 > 0"
      using ‹Re A1  0 HH1  ‹Re A2  0 HH2
      by auto
    show "cos_angle_cmat H1 H2 = sgn_bool (pos_oriented_cmat H1 = pos_oriented_cmat H2) * (r12 + r22 - (cdist a2 a1)2) /  (2 * r1 * r2)"
      unfolding Let_def
      using r1 > 0 r2 > 0
      unfolding cos_angle_cmat_def
      apply (subst divide_minus_left)
      apply (subst *)
      apply (subst Re_sgn[OF ‹is_real A1 A1  0], subst Re_sgn[OF ‹is_real A2 A2  0])
      apply (subst **, subst **)
      apply (simp add: field_simps)
      done
  qed
  ultimately
  show ?thesis
    by simp
qed

(* ----------------------------------------------------------------- *)
subsection ‹Perpendicularity›
(* ----------------------------------------------------------------- *)

text ‹Two circlines are perpendicular if the intersect at right angle i.e., the angle with the cosine
0.›

definition perpendicular where
  "perpendicular H1 H2  cos_angle (of_circline H1) (of_circline H2) = 0"

lemma perpendicular_sym:
  shows "perpendicular H1 H2  perpendicular H2 H1"
  unfolding perpendicular_def
  by (transfer, transfer, auto simp add: field_simps)

(* ----------------------------------------------------------------- *)
subsection ‹Möbius transforms preserve angles and perpendicularity›
(* ----------------------------------------------------------------- *)

text ‹Möbius transformations are \emph{conformal} i.e., they preserve angles between circlines.›

lemma moebius_preserve_circline_angle [simp]:
  shows "cos_angle (moebius_ocircline M H1) (moebius_ocircline M H2) =
         cos_angle H1 H2 "
proof (transfer, transfer)
  fix H1 H2 M :: complex_mat
  assume hh: "mat_det M  0"
  show "cos_angle_cmat (moebius_circline_cmat_cmat M H1) (moebius_circline_cmat_cmat M H2) = cos_angle_cmat H1 H2"
    unfolding cos_angle_cmat_def moebius_circline_cmat_cmat_def
    unfolding Let_def mat_det_12_congruence mat_det_congruence
    using hh mat_det_inv[of M]
    apply (subst cor_squared[symmetric])+
    apply (subst cos_angle_den_scale, simp)
    apply (auto simp add: power2_eq_square real_sqrt_mult field_simps)
    done
qed

lemma perpendicular_moebius [simp]:
  assumes "perpendicular H1 H2"
  shows "perpendicular (moebius_circline M H1) (moebius_circline M H2)"
  using assms
  unfolding perpendicular_def
  using moebius_preserve_circline_angle[of M "of_circline H1" "of_circline H2"]
  using moebius_ocircline_circline[of M "of_circline H1"]
  using moebius_ocircline_circline[of M "of_circline H2"]
  by (auto simp del: moebius_preserve_circline_angle)

end

Theory Unit_Circle_Preserving_Moebius

(* ---------------------------------------------------------------------------- *)
section ‹Unit circle preserving Möbius transformations›
(* ---------------------------------------------------------------------------- *)

text ‹In this section we shall examine Möbius transformations that map the unit circle onto itself.
We shall say that they fix or preserve the unit circle (although, they do not need to fix each of
its points).›

theory Unit_Circle_Preserving_Moebius
imports Unitary11_Matrices Moebius Oriented_Circlines
begin

(* ---------------------------------------------------------------------------- *)
subsection ‹Möbius transformations that fix the unit circle›
(* ---------------------------------------------------------------------------- *)

text ‹We define Möbius transformations that preserve unit circle as transformations represented by
generalized unitary matrices with the $1-1$ signature (elements of the gruop $GU_{1,1}(2,
\mathbb{C})$, defined earlier in the theory Unitary11Matrices).›

lift_definition unit_circle_fix_mmat :: "moebius_mat  bool" is unitary11_gen
  done

lift_definition unit_circle_fix :: "moebius  bool" is unit_circle_fix_mmat
  apply transfer
  apply (auto simp del: mult_sm.simps)
  apply (simp del: mult_sm.simps add: unitary11_gen_mult_sm)
  apply (simp del: mult_sm.simps add: unitary11_gen_div_sm)
  done

text ‹Our algebraic characterisation (by matrices) is geometrically correct.›

lemma unit_circle_fix_iff:
  shows "unit_circle_fix M  
         moebius_circline M unit_circle = unit_circle" (is "?rhs = ?lhs")
proof
  assume ?lhs
  thus ?rhs
  proof (transfer, transfer)
    fix M :: complex_mat
    assume "mat_det M  0"
    assume "circline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat"
    then obtain k where "k  0" "(1, 0, 0, -1) = cor k *sm congruence (mat_inv M) (1, 0, 0, -1)"
      by auto
    hence "(1/cor k, 0, 0, -1/cor k) = congruence (mat_inv M) (1, 0, 0, -1)"
      using mult_sm_inv_l[of "cor k" "congruence (mat_inv M) (1, 0, 0, -1)" ]
      by simp
    hence "congruence M (1/cor k, 0, 0, -1/cor k) = (1, 0, 0, -1)"
      using ‹mat_det M  0 mat_det_inv[of M]
      using congruence_inv[of "mat_inv M" "(1, 0, 0, -1)" "(1/cor k, 0, 0, -1/cor k)"]
      by simp
    hence "congruence M (1, 0, 0, -1) = cor k *sm (1, 0, 0, -1)"
      using congruence_scale_m[of "M" "1/cor k" "(1, 0, 0, -1)"]
      using mult_sm_inv_l[of "1/ cor k" "congruence M (1, 0, 0, -1)"  "(1, 0, 0, -1)"] k  0
      by simp
    thus "unitary11_gen M"
      using k  0
      unfolding unitary11_gen_def
      by simp
  qed
next
  assume ?rhs
  thus ?lhs
  proof (transfer, transfer)
    fix M :: complex_mat
    assume "mat_det M  0"
    assume "unitary11_gen M"
    hence "unitary11_gen (mat_inv M)"
      using ‹mat_det M  0
      using unitary11_gen_mat_inv
      by simp
    thus " circline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat"
      unfolding unitary11_gen_real
      by auto (rule_tac x="1/k" in exI, simp)
  qed
qed

lemma circline_set_fix_iff_circline_fix:
  assumes "circline_set H'  {}"
  shows "circline_set (moebius_circline M H) = circline_set H'  
         moebius_circline M H = H'"
  using assms
  by auto (rule inj_circline_set, auto)

lemma unit_circle_fix_iff_unit_circle_set:
  shows "unit_circle_fix M  moebius_pt M ` unit_circle_set = unit_circle_set"
proof-
  have "circline_set unit_circle  {}"
    using one_in_unit_circle_set
    by auto
  thus ?thesis
    using unit_circle_fix_iff[of M] circline_set_fix_iff_circline_fix[of unit_circle M unit_circle]
    by (simp add: unit_circle_set_def)
qed


text ‹Unit circle preserving Möbius transformations form a group. ›

lemma unit_circle_fix_id_moebius [simp]:
  shows "unit_circle_fix id_moebius"
  by (transfer, transfer, simp add: unitary11_gen_def mat_adj_def mat_cnj_def)

lemma unit_circle_fix_moebius_add [simp]:
  assumes "unit_circle_fix M1" and "unit_circle_fix M2"
  shows "unit_circle_fix (M1 + M2)"
  using assms
  unfolding unit_circle_fix_iff
  by auto

lemma unit_circle_fix_moebius_comp [simp]:
  assumes "unit_circle_fix M1" and "unit_circle_fix M2"
  shows "unit_circle_fix (moebius_comp M1 M2)"
  using unit_circle_fix_moebius_add[OF assms]
  by simp

lemma unit_circle_fix_moebius_uminus [simp]:
  assumes "unit_circle_fix M"
  shows "unit_circle_fix (-M)"
  using assms
  unfolding unit_circle_fix_iff
  by (metis moebius_circline_comp_inv_left uminus_moebius_def)

lemma unit_circle_fix_moebius_inv [simp]:
  assumes "unit_circle_fix M"
  shows "unit_circle_fix (moebius_inv M)"
  using unit_circle_fix_moebius_uminus[OF assms]
  by simp

text ‹Unit circle fixing transforms preserve inverse points.›

lemma unit_circle_fix_moebius_pt_inversion [simp]:
  assumes "unit_circle_fix M"
  shows "moebius_pt M (inversion z) = inversion (moebius_pt M z)"
  using assms
  using symmetry_principle[of z "inversion z" unit_circle M]
  using unit_circle_fix_iff[of M, symmetric]
  using circline_symmetric_inv_homo_disc[of z]
  using circline_symmetric_inv_homo_disc'[of "moebius_pt M z" "moebius_pt M (inversion z)"]
  by metis

(* -------------------------------------------------------------------------- *)
subsection ‹Möbius transformations that fix the imaginary unit circle›
(* -------------------------------------------------------------------------- *)

text ‹Only for completeness we show that Möbius transformations that preserve the imaginary unit
circle are exactly those characterised by generalized unitary matrices (with the (2, 0) signature).›
lemma imag_unit_circle_fixed_iff_unitary_gen:
  assumes "mat_det (A, B, C, D)  0"
  shows "moebius_circline (mk_moebius A B C D) imag_unit_circle = imag_unit_circle 
         unitary_gen (A, B, C, D)" (is "?lhs = ?rhs")
proof
  assume ?lhs
  thus ?rhs
    using assms
  proof (transfer, transfer)
    fix A B C D :: complex
    let ?M = "(A, B, C, D)" and ?E = "(1, 0, 0, 1)"
    assume "circline_eq_cmat (moebius_circline_cmat_cmat (mk_moebius_cmat A B C D) imag_unit_circle_cmat) imag_unit_circle_cmat"
           "mat_det ?M  0"
    then obtain k where "k  0" "?E = cor k *sm congruence (mat_inv ?M) ?E"
      by auto
    hence "unitary_gen (mat_inv ?M)"
      using mult_sm_inv_l[of "cor k" "congruence (mat_inv ?M) ?E" "?E"]
      unfolding unitary_gen_def
      by (metis congruence_def divide_eq_0_iff eye_def mat_eye_r of_real_eq_0_iff one_neq_zero)
    thus "unitary_gen ?M"
      using unitary_gen_inv[of "mat_inv ?M"] ‹mat_det ?M  0
      by (simp del: mat_inv.simps)
  qed
next
  assume ?rhs
  thus ?lhs
    using assms
  proof (transfer, transfer)
    fix A B C D :: complex
    let ?M = "(A, B, C, D)" and ?E = "(1, 0, 0, 1)"
    assume "unitary_gen ?M" "mat_det ?M  0"
    hence "unitary_gen (mat_inv ?M)"
      using unitary_gen_inv[of ?M]
      by simp
    then obtain k where "k  0" "mat_adj (mat_inv ?M) *mm (mat_inv ?M) = cor k *sm eye"
      using unitary_gen_real[of "mat_inv ?M"] mat_det_inv[of ?M]
      by auto
    hence *: "?E = (1 / cor k) *sm (mat_adj (mat_inv ?M) *mm (mat_inv ?M))"
      using mult_sm_inv_l[of "cor k" eye "mat_adj (mat_inv ?M) *mm (mat_inv ?M)"]
      by simp
    have "k. k  0 
            (1, 0, 0, 1) = cor k *sm (mat_adj (mat_inv (A, B, C, D)) *mm (1, 0, 0, 1) *mm mat_inv (A, B, C, D))"
      using ‹mat_det ?M  0 k  0 
      by (metis "*" Im_complex_of_real Re_complex_of_real ‹mat_adj (mat_inv ?M) *mm mat_inv ?M = cor k *sm eye› complex_of_real_Re eye_def mat_eye_l mult_mm_assoc mult_mm_sm mult_sm_eye_mm of_real_1 of_real_divide of_real_eq_1_iff zero_eq_1_divide_iff)
    thus "circline_eq_cmat (moebius_circline_cmat_cmat (mk_moebius_cmat A B C D) imag_unit_circle_cmat) imag_unit_circle_cmat"
      using ‹mat_det ?M  0 k  0 
      by (simp del: mat_inv.simps)
  qed
qed

(* -------------------------------------------------------------------------- *)
subsection ‹Möbius transformations that fix the oriented unit circle and the unit disc›
(* -------------------------------------------------------------------------- *)

text ‹Möbius transformations that fix the unit circle either map the unit disc onto itself or
exchange it with its exterior. The transformations that fix the unit disc can be recognized from
their matrices -- they have the form as before, but additionally it must hold that $|a|^2 > |b|^2$.›
  
definition unit_disc_fix_cmat :: "complex_mat  bool" where
 [simp]: "unit_disc_fix_cmat M 
          (let (A, B, C, D) = M
            in unitary11_gen (A, B, C, D)  (B = 0  Re ((A*D)/(B*C)) > 1))"

lift_definition unit_disc_fix_mmat :: "moebius_mat  bool" is unit_disc_fix_cmat
  done

lift_definition unit_disc_fix :: "moebius  bool" is unit_disc_fix_mmat
proof transfer
  fix M M' :: complex_mat
  assume det: "mat_det M  0" "mat_det M'  0"
  assume "moebius_cmat_eq M M'"
  then obtain k where *: "k  0" "M' = k *sm M"
    by auto
  hence **: "unitary11_gen M  unitary11_gen M'"
    using unitary11_gen_mult_sm[of k M] unitary11_gen_div_sm[of k M]
    by auto
  obtain A B C D where MM: "(A, B, C, D) = M"
    by (cases M) auto
  obtain A' B' C' D' where MM': "(A', B', C', D') = M'"
    by (cases M') auto

  show "unit_disc_fix_cmat M = unit_disc_fix_cmat M'"
    using * ** MM MM'
    by auto
qed

text ‹Transformations that fix the unit disc also fix the unit circle.›
lemma unit_disc_fix_unit_circle_fix [simp]:
  assumes "unit_disc_fix M"
  shows "unit_circle_fix M"
  using assms
  by (transfer, transfer, auto)

text ‹Transformations that preserve the unit disc preserve the orientation of the unit circle.›
lemma unit_disc_fix_iff_ounit_circle:
  shows "unit_disc_fix M  
         moebius_ocircline M ounit_circle = ounit_circle" (is "?rhs  ?lhs")
proof
  assume *: ?lhs
  have "moebius_circline M unit_circle = unit_circle"
    apply (subst moebius_circline_ocircline[of M unit_circle])
    apply (subst of_circline_unit_circle)
    apply (subst *)
    by simp

  hence "unit_circle_fix M"
    by (simp add: unit_circle_fix_iff)
  thus ?rhs
    using *
  proof (transfer, transfer)
    fix M :: complex_mat
    assume "mat_det M  0"
    let ?H = "(1, 0, 0, -1)"
    obtain A B C D where MM: "(A, B, C, D) = M"
      by (cases M) auto
    assume "unitary11_gen M" "ocircline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat"
    then obtain k where "0 < k" "?H = cor k *sm congruence (mat_inv M) ?H"
      by auto
    hence "congruence M ?H = cor k *sm ?H"
      using congruence_inv[of "mat_inv M" "?H" "(1/cor k) *sm ?H"] ‹mat_det M  0
      using mult_sm_inv_l[of "cor k" "congruence (mat_inv M) ?H" "?H"]
      using mult_sm_inv_l[of "1/cor k" "congruence M ?H"]
      using congruence_scale_m[of M "1/cor k" "?H"]
      using B. 1 / cor k  0; (1 / cor k) *sm congruence M (1, 0, 0, - 1) = B  congruence M (1, 0, 0, - 1) = (1 / (1 / cor k)) *sm B
      by (auto simp add: mat_det_inv)
    then obtain a b k' where "k'  0" "M = k' *sm (a, b, cnj b, cnj a)" "sgn (Re (mat_det (a, b, cnj b, cnj a))) = 1"
      using unitary11_sgn_det_orientation'[of M k] k > 0
      by auto
    moreover
    have "mat_det (a, b, cnj b, cnj a)  0"
      using ‹sgn (Re (mat_det (a, b, cnj b, cnj a))) = 1
      by (smt sgn_0 zero_complex.simps(1))
    ultimately
    show "unit_disc_fix_cmat M"
      using unitary11_sgn_det[of k' a b M A B C D]
      using MM[symmetric] k > 0 ‹unitary11_gen M
      by (simp add: sgn_1_pos split: if_split_asm)
  qed
next
  assume ?rhs
  thus ?lhs
  proof (transfer, transfer)
    fix M :: complex_mat
    assume "mat_det M  0"

    obtain A B C D where MM: "(A, B, C, D) = M"
      by (cases M) auto
    assume "unit_disc_fix_cmat M"
    hence "unitary11_gen M" "B = 0  1 < Re (A * D / (B * C))"
      using MM[symmetric]
      by auto
    have "sgn (if B = 0 then 1 else sgn (Re (A * D / (B * C)) - 1)) = 1"
      using B = 0  1 < Re (A * D / (B * C))
      by auto
    then obtain k' where "k' > 0" "congruence M (1, 0, 0, -1) = cor k' *sm (1, 0, 0, -1)"
      using unitary11_orientation[OF ‹unitary11_gen M MM[symmetric]]
      by (auto simp add: sgn_1_pos)
    thus "ocircline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat"
      using congruence_inv[of M "(1, 0, 0, -1)" "cor k' *sm (1, 0, 0, -1)"] ‹mat_det M  0
      using congruence_scale_m[of "mat_inv M" "cor k'" "(1, 0, 0, -1)"]
      by auto
  qed
qed


text ‹Our algebraic characterisation (by matrices) is geometrically correct.›

lemma unit_disc_fix_iff [simp]:
  assumes "unit_disc_fix M"
  shows "moebius_pt M ` unit_disc = unit_disc"
  using assms
  using unit_disc_fix_iff_ounit_circle[of M]
  unfolding unit_disc_def
  by (subst disc_moebius_ocircline[symmetric], simp)

lemma unit_disc_fix_discI [simp]:
  assumes "unit_disc_fix M" and "u  unit_disc"
  shows "moebius_pt M u  unit_disc"
  using unit_disc_fix_iff assms
  by blast

text ‹Unit disc preserving transformations form a group.›

lemma unit_disc_fix_id_moebius [simp]:
  shows "unit_disc_fix id_moebius"
  by (transfer, transfer, simp add: unitary11_gen_def mat_adj_def mat_cnj_def)

lemma unit_disc_fix_moebius_add [simp]:
  assumes "unit_disc_fix M1" and "unit_disc_fix M2"
  shows "unit_disc_fix (M1 + M2)"
  using assms
  unfolding unit_disc_fix_iff_ounit_circle
  by auto

lemma unit_disc_fix_moebius_comp [simp]:
  assumes "unit_disc_fix M1" and "unit_disc_fix M2"
  shows "unit_disc_fix (moebius_comp M1 M2)"
  using unit_disc_fix_moebius_add[OF assms]
  by simp

lemma unit_disc_fix_moebius_uminus [simp]:
  assumes "unit_disc_fix M"
  shows "unit_disc_fix (-M)"
  using assms
  unfolding unit_disc_fix_iff_ounit_circle
  by (metis moebius_ocircline_comp_inv_left uminus_moebius_def)

lemma unit_disc_fix_moebius_inv [simp]:
  assumes "unit_disc_fix M"
  shows "unit_disc_fix (moebius_inv M)"
  using unit_disc_fix_moebius_uminus[OF assms]
  by simp

(* -------------------------------------------------------------------------- *)
subsection ‹Rotations are unit disc preserving transformations›
(* -------------------------------------------------------------------------- *)

lemma unit_disc_fix_rotation [simp]:
  shows "unit_disc_fix (moebius_rotation φ)"      
  unfolding moebius_rotation_def moebius_similarity_def
  by (transfer, transfer, simp add: unitary11_gen_def mat_adj_def mat_cnj_def cis_mult)

lemma moebius_rotation_unit_circle_fix [simp]:
  shows "moebius_pt (moebius_rotation φ) u  unit_circle_set  u  unit_circle_set"
  using moebius_pt_moebius_inv_in_set unit_circle_fix_iff_unit_circle_set
  by fastforce

lemma ex_rotation_mapping_u_to_positive_x_axis:
  assumes "u  0h" and "u  h"
  shows " φ. moebius_pt (moebius_rotation φ) u  positive_x_axis"
proof-
  from assms obtain c where *: "u = of_complex c"
    using inf_or_of_complex
    by blast
  have "is_real (cis (- arg c) * c)" "Re (cis (-arg c) * c) > 0"
    using "*" assms is_real_rot_to_x_axis positive_rot_to_x_axis of_complex_zero_iff
    by blast+
  thus ?thesis
    using *
    by (rule_tac x="-arg c" in exI) (simp add: positive_x_axis_def circline_set_x_axis)
qed

lemma ex_rotation_mapping_u_to_positive_y_axis:
  assumes "u  0h" and "u  h"
  shows " φ. moebius_pt (moebius_rotation φ) u  positive_y_axis"
proof-
  from assms obtain c where *: "u = of_complex c"
    using inf_or_of_complex
    by blast
  have "is_imag (cis (pi/2 - arg c) * c)" "Im (cis (pi/2 - arg c) * c) > 0"
    using "*" assms is_real_rot_to_x_axis positive_rot_to_x_axis of_complex_zero_iff
    by - (simp, simp, simp add: field_simps)
  thus ?thesis
    using *
    by (rule_tac x="pi/2-arg c" in exI) (simp add: positive_y_axis_def circline_set_y_axis)
qed

lemma wlog_rotation_to_positive_x_axis:
  assumes in_disc: "u  unit_disc" and not_zero: "u  0h"
  assumes preserving: "φ u. u  unit_disc; u  0h; P (moebius_pt (moebius_rotation φ) u)  P u"
  assumes x_axis: "x. is_real x; 0 < Re x; Re x < 1  P (of_complex x)"
  shows "P u"
proof-
  from in_disc obtain φ where *:
    "moebius_pt (moebius_rotation φ) u  positive_x_axis"
    using ex_rotation_mapping_u_to_positive_x_axis[of u]
    using inf_notin_unit_disc not_zero
    by blast
  let ?Mu = "moebius_pt (moebius_rotation φ) u"
  have "P ?Mu"
  proof-
    let ?x = "to_complex ?Mu"
    have "?Mu  unit_disc" "?Mu  0h" "?Mu  h"
      using u  unit_disc› u  0h
      by auto
    hence "is_real (to_complex ?Mu)"  "0 < Re ?x" "Re ?x < 1"
      using *
      unfolding positive_x_axis_def circline_set_x_axis
      by (auto simp add: cmod_eq_Re)
    thus ?thesis
      using x_axis[of ?x] ?Mu  h
      by simp
  qed
  thus ?thesis
    using preserving[OF in_disc] not_zero
    by simp
qed

lemma wlog_rotation_to_positive_x_axis':
  assumes not_zero: "u  0h" and not_inf: "u  h"
  assumes preserving: "φ u. u  0h; u  h; P (moebius_pt (moebius_rotation φ) u)  P u"
  assumes x_axis: "x. is_real x; 0 < Re x  P (of_complex x)"
  shows "P u"
proof-
  from not_zero and not_inf obtain φ where *:
    "moebius_pt (moebius_rotation φ) u  positive_x_axis"
    using ex_rotation_mapping_u_to_positive_x_axis[of u]
    using inf_notin_unit_disc
    by blast
  let ?Mu = "moebius_pt (moebius_rotation φ) u"
  have "P ?Mu"
  proof-
    let ?x = "to_complex ?Mu"
    have "?Mu  0h" "?Mu  h"
      using u  h u  0h
      by auto
    hence "is_real (to_complex ?Mu)"  "0 < Re ?x"
      using *
      unfolding positive_x_axis_def circline_set_x_axis
      by (auto simp add: cmod_eq_Re)
    thus ?thesis
      using x_axis[of ?x] ?Mu  h
      by simp
  qed
  thus ?thesis
    using preserving[OF not_zero not_inf]
    by simp
qed

lemma wlog_rotation_to_positive_y_axis:
  assumes in_disc: "u  unit_disc" and not_zero: "u  0h"
  assumes preserving: "φ u. u  unit_disc; u  0h; P (moebius_pt (moebius_rotation φ) u)  P u"
  assumes y_axis: "x. is_imag x; 0 < Im x; Im x < 1  P (of_complex x)"
  shows "P u"
proof-
  from in_disc and not_zero obtain φ where *:
    "moebius_pt (moebius_rotation φ) u  positive_y_axis"
    using ex_rotation_mapping_u_to_positive_y_axis[of u]
    using inf_notin_unit_disc
    by blast
  let ?Mu = "moebius_pt (moebius_rotation φ) u"
  have "P ?Mu"
  proof-
    let ?y = "to_complex ?Mu"
    have "?Mu  unit_disc" "?Mu  0h" "?Mu  h"
      using u  unit_disc› u  0h
      by auto
    hence "is_imag (to_complex ?Mu)"  "0 < Im ?y" "Im ?y < 1"
      using *
      unfolding positive_y_axis_def circline_set_y_axis
      by (auto simp add: cmod_eq_Im)
    thus ?thesis
      using y_axis[of ?y] ?Mu  h
      by simp
  qed
  thus ?thesis
    using preserving[OF in_disc not_zero]
    by simp
qed

(* ---------------------------------------------------------------------------- *)
subsection ‹Blaschke factors are unit disc preserving transformations›
(* ---------------------------------------------------------------------------- *)

text ‹For a given point $a$, Blaschke factor transformations are of the form $k \cdot
\left(\begin{array}{cc}1 & -a\\ -\overline{a} & 1\end{array}\right)$. It is a disc preserving
Möbius transformation that maps the point $a$ to zero (by the symmetry principle, it must map the
inverse point of $a$ to infinity).›

definition blaschke_cmat :: "complex  complex_mat" where
 [simp]: "blaschke_cmat a = (if cmod a  1 then (1, -a, -cnj a, 1) else eye)"
lift_definition blaschke_mmat :: "complex  moebius_mat" is blaschke_cmat
  by simp
lift_definition blaschke :: "complex  moebius" is blaschke_mmat
  done

lemma blaschke_0_id [simp]: "blaschke 0 = id_moebius"
  by (transfer, transfer, simp)

lemma blaschke_a_to_zero [simp]:
  assumes "cmod a  1"
  shows "moebius_pt (blaschke a) (of_complex a) = 0h"
  using assms
  by (transfer, transfer, simp)

lemma blaschke_inv_a_inf [simp]:
  assumes "cmod a  1"
  shows "moebius_pt (blaschke a) (inversion (of_complex a)) = h"
  using assms
  unfolding inversion_def
  by (transfer, transfer) (simp add: vec_cnj_def, rule_tac x="1/(1 - a*cnj a)" in exI, simp)

lemma blaschke_inf [simp]:
  assumes "cmod a < 1" and "a  0"
  shows "moebius_pt (blaschke a) h = of_complex (- 1 / cnj a)"
  using assms
  by (transfer, transfer, simp add: complex_mod_sqrt_Re_mult_cnj)

lemma blaschke_0_minus_a [simp]:
  assumes "cmod a  1"
  shows "moebius_pt (blaschke a) 0h = ~h (of_complex a)"
  using assms
  by (transfer, transfer, simp)
                                                
lemma blaschke_unit_circle_fix [simp]:
  assumes "cmod a  1"
  shows "unit_circle_fix (blaschke a)"
  using assms
  by (transfer, transfer) (simp add: unitary11_gen_def mat_adj_def mat_cnj_def)

lemma blaschke_unit_disc_fix [simp]:
  assumes "cmod a < 1"
  shows "unit_disc_fix (blaschke a)"
  using assms
proof (transfer, transfer)
  fix a
  assume *: "cmod a < 1"
  show "unit_disc_fix_cmat (blaschke_cmat a)"
  proof (cases "a = 0")
    case True
    thus ?thesis
      by (simp add: unitary11_gen_def mat_adj_def mat_cnj_def)
  next
    case False
    hence "Re (a * cnj a) < 1"
      using *
      by (metis complex_mod_sqrt_Re_mult_cnj real_sqrt_lt_1_iff)
    hence "1 / Re (a * cnj a) > 1"
      using False
      by (smt complex_div_gt_0 less_divide_eq_1_pos one_complex.simps(1) right_inverse_eq)
    hence "Re (1 / (a * cnj a)) > 1"
      by (simp add: complex_is_Real_iff)
    thus ?thesis
      by (simp add: unitary11_gen_def mat_adj_def mat_cnj_def)
  qed
qed

lemma blaschke_unit_circle_fix':
  assumes "cmod a  1"
  shows "moebius_circline (blaschke a) unit_circle = unit_circle"
  using assms
  using blaschke_unit_circle_fix unit_circle_fix_iff
  by simp

lemma blaschke_ounit_circle_fix':
  assumes "cmod a < 1"
  shows "moebius_ocircline (blaschke a) ounit_circle = ounit_circle"
proof-
  have "Re (a * cnj a) < 1"
    using assms
    by (metis complex_mod_sqrt_Re_mult_cnj real_sqrt_lt_1_iff)
  thus ?thesis
    using assms
    using blaschke_unit_disc_fix unit_disc_fix_iff_ounit_circle
    by simp
qed

lemma moebius_pt_blaschke [simp]:
  assumes "cmod a  1" and "z  1 / cnj a"
  shows "moebius_pt (blaschke a) (of_complex z) = of_complex ((z - a) / (1 - cnj a * z))"
  using assms
proof (cases "a = 0")
  case True
  thus ?thesis
    by auto
next
  case False
  thus ?thesis
    using assms
    apply (transfer, transfer)
    apply (simp add: complex_mod_sqrt_Re_mult_cnj)
    apply (rule_tac x="1 / (1 - cnj a * z)" in exI)
    apply (simp add: field_simps)
    done
qed

(* -------------------------------------------------------------------------- *)
subsubsection ‹Blaschke factors for a real point $a$›
(* -------------------------------------------------------------------------- *)

text ‹If the point $a$ is real, the Blaschke factor preserve x-axis and the upper and the lower
halfplane.›

lemma blaschke_real_preserve_x_axis [simp]:
  assumes "is_real a" and "cmod a < 1"
  shows "moebius_pt (blaschke a) z  circline_set x_axis  z  circline_set x_axis"
proof (cases "a = 0")
  case True
  thus ?thesis
    by simp
next
  case False
  have "cmod a  1"
    using assms
    by linarith
  let ?a = "of_complex a"
  let ?i = "inversion ?a"
  let ?M = "moebius_pt (blaschke a)"
  have *: "?M ?a = 0h" "?M ?i = h" "?M 0h = of_complex (-a)"
    using ‹cmod a  1 blaschke_a_to_zero[of a] blaschke_inv_a_inf[of a] blaschke_0_minus_a[of a]
    by auto
  let ?Mx = "moebius_circline (blaschke a) x_axis"
  have "?a  circline_set x_axis" "?i  circline_set x_axis" "0h  circline_set x_axis"
    using ‹is_real a a  0 eq_cnj_iff_real[of a]
    by auto
  hence "0h  circline_set ?Mx" "h  circline_set ?Mx" "of_complex (-a)  circline_set ?Mx"
    using *
    apply -                          
    apply (force simp add: image_iff)+
    apply (simp add: image_iff, rule_tac x="0h" in bexI, simp_all)   
    done
  moreover
  have "0h  circline_set x_axis" "h  circline_set x_axis" "of_complex (-a)  circline_set x_axis"
    using ‹is_real a 
    by auto
  moreover
  have "of_complex (-a)  0h"
    using a  0
    by simp
  hence "0h  of_complex (-a)"
    by metis
  hence "∃!H. 0h  circline_set H  h  circline_set H  of_complex (- a)  circline_set H"
    using unique_circline_set[of "0h" "h" "of_complex (-a)"] a  0
    by simp
  ultimately
  have "moebius_circline (blaschke a) x_axis = x_axis"
    by auto
  thus ?thesis
    by (metis circline_set_moebius_circline_iff)
qed

lemma blaschke_real_preserve_sgn_Im [simp]:
  assumes "is_real a" and "cmod a < 1" and "z  h" and "z  inversion (of_complex a)"
  shows "sgn (Im (to_complex (moebius_pt (blaschke a) z))) = sgn (Im (to_complex z))"
proof (cases "a = 0")
  case True
  thus ?thesis
    by simp
next
  case False
  obtain z' where z': "z = of_complex z'"
    using inf_or_of_complex[of z] z  h
    by auto
  have "z'  1 / cnj a"
    using assms z' a  0
    by (auto simp add: of_complex_inj)
  moreover
  have "a * cnj a  1"
    using ‹cmod a < 1
    by auto (simp add: complex_mod_sqrt_Re_mult_cnj)
  moreover
  have "sgn (Im ((z' - a) / (1 - a * z'))) = sgn (Im z')"
  proof-
    have "a * z'  1"
      using ‹is_real a z'  1 / cnj a a  0 eq_cnj_iff_real[of a]
      by (simp add: field_simps)
    moreover                             
    have "Re (1 - a2) > 0"
      using ‹is_real a ‹cmod a < 1
      by (smt Re_power2 minus_complex.simps(1) norm_complex_def one_complex.simps(1) power2_less_0 real_sqrt_lt_1_iff)
    moreover
    have "Im ((z' - a) / (1 - a * z')) = Re (((1 - a2) * Im z') / (cmod (1 - a*z'))2)"
    proof-
      have "1 - a * cnj z'  0"
        using z'  1 / cnj a
        by (metis Im_complex_div_eq_0  complex_cnj_zero_iff diff_eq_diff_eq diff_numeral_special(9) eq_divide_imp is_real_div mult_not_zero one_complex.simps(2) zero_neq_one)
      hence "Im ((z' - a) / (1 - a * z')) = Im (((z' - a) * (1 - a * cnj z')) / ((1 - a * z') * cnj (1 - a * z')))"
        using ‹is_real a eq_cnj_iff_real[of a]
        by simp
      also have "... = Im ((z' - a - a * z' * cnj z' + a2 * cnj z') / (cmod (1 - a*z'))2)"
        unfolding complex_mult_cnj_cmod
        by (simp add: power2_eq_square field_simps)
      finally show ?thesis
        using ‹is_real a
        by (simp add: field_simps) 
    qed
    moreover
    have "0 < (1 - (Re a)2) * Im z' / (cmod (1 - a * z'))2  Im z' > 0"
      using ‹is_real a 0 < Re (1 - a2) 
      by (smt Re_power_real divide_le_0_iff minus_complex.simps(1) not_sum_power2_lt_zero one_complex.simps(1) zero_less_mult_pos)
    ultimately
    show ?thesis
      unfolding sgn_real_def
      using ‹cmod a < 1 a * z'  1 ‹is_real a
      by (auto simp add: cmod_eq_Re)
  qed
  ultimately
  show ?thesis
    using assms z' moebius_pt_blaschke[of a z'] ‹is_real a eq_cnj_iff_real[of a]                  
    by simp
qed

lemma blaschke_real_preserve_sgn_arg [simp]:
  assumes "is_real a" and "cmod a < 1" and "z  circline_set x_axis"
  shows "sgn (arg (to_complex (moebius_pt (blaschke a) z))) = sgn (arg (to_complex z))"
proof-
  have "z  h"
    using assms
    using special_points_on_x_axis''(3) by blast
  moreover
  have "z  inversion (of_complex a)"
    using assms
    by (metis calculation circline_equation_x_axis circline_set_x_axis_I conjugate_of_complex inversion_of_complex inversion_sym is_real_inversion o_apply of_complex_zero reciprocal_zero to_complex_of_complex)
  ultimately
  show ?thesis
    using blaschke_real_preserve_sgn_Im[OF assms(1) assms(2), of z]
    by (smt arg_Im_sgn assms(3) circline_set_x_axis_I norm_sgn of_complex_to_complex)
qed

(* -------------------------------------------------------------------------- *)
subsubsection ‹Inverse Blaschke transform›
(* -------------------------------------------------------------------------- *)

definition inv_blaschke_cmat :: "complex  complex_mat" where
 [simp]: "inv_blaschke_cmat a = (if cmod a  1 then (1, a, cnj a, 1) else eye)"
lift_definition inv_blaschke_mmat :: "complex  moebius_mat" is inv_blaschke_cmat
  by simp
lift_definition inv_blaschke :: "complex  moebius" is inv_blaschke_mmat
  done

lemma inv_blaschke_neg [simp]: "inv_blaschke a = blaschke (-a)"
  by (transfer, transfer) simp

lemma inv_blaschke:
  assumes "cmod a  1"
  shows "blaschke a + inv_blaschke a = 0"
  apply simp
  apply (transfer, transfer)
  by auto (rule_tac x="1/(1 - a*cnj a)" in exI, simp)

lemma ex_unit_disc_fix_mapping_u_to_zero:
  assumes "u  unit_disc"
  shows " M. unit_disc_fix M  moebius_pt M u = 0h"
proof-
  from assms obtain c where *: "u = of_complex c"
    by (metis inf_notin_unit_disc inf_or_of_complex)
  hence "cmod c < 1"
    using assms unit_disc_iff_cmod_lt_1
    by simp
  thus ?thesis
    using *
    by (rule_tac x="blaschke c" in exI)
       (smt blaschke_a_to_zero blaschke_ounit_circle_fix' unit_disc_fix_iff_ounit_circle)
qed

lemma wlog_zero:
  assumes in_disc: "u  unit_disc"
  assumes preserving: " a u. u  unit_disc; cmod a < 1; P (moebius_pt (blaschke a) u)  P u"
  assumes zero: "P 0h"
  shows "P u"
proof-
  have *: "moebius_pt (blaschke (to_complex u)) u = 0h"
    by (smt blaschke_a_to_zero in_disc inf_notin_unit_disc of_complex_to_complex unit_disc_iff_cmod_lt_1)
  thus ?thesis
    using preserving[of u "to_complex u"] in_disc zero
    using inf_or_of_complex[of u]
    by auto
qed

lemma wlog_real_zero:
  assumes in_disc: "u  unit_disc" and real: "is_real (to_complex u)"
  assumes preserving: " a u. u  unit_disc; is_real a; cmod a < 1; P (moebius_pt (blaschke a) u)  P u"
  assumes zero: "P 0h"
  shows "P u"
proof-
  have *: "moebius_pt (blaschke (to_complex u)) u = 0h"
    by (smt blaschke_a_to_zero in_disc inf_notin_unit_disc of_complex_to_complex unit_disc_iff_cmod_lt_1)
  thus ?thesis
    using preserving[of u "to_complex u"] in_disc zero real
    using inf_or_of_complex[of u]
    by auto
qed

lemma unit_disc_fix_transitive:
  assumes in_disc: "u  unit_disc" and "u'  unit_disc"
  shows " M. unit_disc_fix M  moebius_pt M u = u'"
proof-
  have " u  unit_disc.  M. unit_disc_fix M  moebius_pt M u = u'" (is "?P u'")
  proof (rule wlog_zero)
    show "u'  unit_disc" by fact
  next
    show "?P 0h"
      by (simp add: ex_unit_disc_fix_mapping_u_to_zero)
  next
    fix a u
    assume "cmod a < 1" and *: "?P (moebius_pt (blaschke a) u)"
    show "?P u"
    proof
      fix u'
      assume "u'  unit_disc"
      then obtain M' where "unit_disc_fix M'" "moebius_pt M' u' = moebius_pt (blaschke a) u"
        using *
        by auto
      thus "M. unit_disc_fix M  moebius_pt M u' = u"
        using ‹cmod a < 1 blaschke_unit_disc_fix[of a]
        using unit_disc_fix_moebius_comp[of "- blaschke a" "M'"]
        using unit_disc_fix_moebius_inv[of "blaschke a"]
        by (rule_tac x="(- (blaschke a)) + M'" in exI, simp)
    qed
  qed
  thus ?thesis
    using assms
    by auto
qed

(* -------------------------------------------------------------------------- *)
subsection ‹Decomposition of unit disc preserving Möbius transforms›
(* -------------------------------------------------------------------------- *)

text ‹Each transformation preserving unit disc can be decomposed to a rotation around the origin and
a Blaschke factors that maps a point within the unit disc to zero.›

lemma unit_disc_fix_decompose_blaschke_rotation:
  assumes "unit_disc_fix M"
  shows " k φ. cmod k < 1  M = moebius_rotation φ + blaschke k"
  using assms
  unfolding moebius_rotation_def moebius_similarity_def
proof (simp, transfer, transfer)
  fix M
  assume *: "mat_det M  0" "unit_disc_fix_cmat M"
  then obtain k a b :: complex where
    **: "k  0" "mat_det (a, b, cnj b, cnj a)  0" "M = k *sm (a, b, cnj b, cnj a)"
    using unitary11_gen_iff[of M]
    by auto
  have "a  0"
    using * **
    by auto
  then obtain a' k' φ
    where ***: "k'  0  a' * cnj a'  1  M = k' *sm (cis φ, 0, 0, 1) *mm (1, - a', - cnj a', 1)"
    using ** unitary11_gen_cis_blaschke[of k M a b]
    by auto blast
  have "a' = 0  1 < 1 / (cmod a')2"
    using * *** complex_mult_cnj_cmod[of a']
    by simp
  hence "cmod a' < 1"
    by (smt less_divide_eq_1_pos norm_zero one_less_power one_power2 pos2)
  thus "k. cmod k < 1 
            (φ. moebius_cmat_eq M (moebius_comp_cmat (mk_moebius_cmat (cis φ) 0 0 1) (blaschke_cmat k)))"
    using ***
    apply (rule_tac x=a' in exI)
    apply simp
    apply (rule_tac x=φ in exI)
    apply simp
    apply (rule_tac x="1/k'" in exI)
    by auto
qed

lemma wlog_unit_disc_fix:
  assumes "unit_disc_fix M"
  assumes b: " k. cmod k < 1  P (blaschke k)"
  assumes r: " φ. P (moebius_rotation φ)"
  assumes comp: "M1 M2. unit_disc_fix M1; P M1; unit_disc_fix M2; P M2  P (M1 + M2)"
  shows "P M"
  using assms
  using unit_disc_fix_decompose_blaschke_rotation[OF assms(1)]
  using blaschke_unit_disc_fix
  by auto

lemma ex_unit_disc_fix_to_zero_positive_x_axis:
  assumes "u  unit_disc" and "v  unit_disc" and "u  v"
  shows " M. unit_disc_fix M 
              moebius_pt M u = 0h  moebius_pt M v  positive_x_axis"
proof-
  from assms obtain B where
    *: "unit_disc_fix B" "moebius_pt B u = 0h"
    using ex_unit_disc_fix_mapping_u_to_zero
    by blast

  let ?v = "moebius_pt B v"
  have "?v  unit_disc"
    using v  unit_disc› *
    by auto
  hence "?v  h"
    using inf_notin_unit_disc by auto
  have "?v  0h"
    using u  v *
    by (metis moebius_pt_invert)

  obtain R where
    "unit_disc_fix R"
    "moebius_pt R 0h = 0h" "moebius_pt R ?v  positive_x_axis"
    using ex_rotation_mapping_u_to_positive_x_axis[of ?v] ?v  0h ?v  h
    using moebius_pt_rotation_inf_iff moebius_pt_moebius_rotation_zero unit_disc_fix_rotation
    by blast
  thus ?thesis
    using * moebius_comp[of R B, symmetric]
    using unit_disc_fix_moebius_comp
    by (rule_tac x="R + B" in exI) (simp add: comp_def)
qed

lemma wlog_x_axis:
  assumes in_disc: "u  unit_disc" "v  unit_disc"
  assumes preserved: " M u v. unit_disc_fix M; u  unit_disc; v  unit_disc; P (moebius_pt M u) (moebius_pt M v)  P u v"
  assumes axis: " x. is_real x; 0  Re x;  Re x < 1  P 0h (of_complex x)"
  shows "P u v"
proof (cases "u = v")
  case True
  have "P u u" (is "?Q u")
  proof (rule wlog_zero[where P="?Q"])
    show "u  unit_disc"
      by fact
  next
    show "?Q 0h"
      using axis[of 0]
      by simp
  next
    fix a u
    assume "u  unit_disc" "cmod a < 1" "?Q (moebius_pt (blaschke a) u)"
    thus "?Q u"
      using preserved[of "blaschke a" u u]
      using blaschke_unit_disc_fix[of a]
      by simp
  qed
  thus ?thesis
    using True
    by simp
next
  case False
  from in_disc obtain M where
    *: "unit_disc_fix M" "moebius_pt M u = 0h" "moebius_pt M v  positive_x_axis"
    using ex_unit_disc_fix_to_zero_positive_x_axis False
    by auto
  then obtain x where **: "moebius_pt M v = of_complex x" "is_real x"
    unfolding positive_x_axis_def circline_set_x_axis
    by auto
  moreover
  have "of_complex x  unit_disc"
    using ‹unit_disc_fix M v  unit_disc› **
    using unit_disc_fix_discI
    by fastforce
  hence "0 < Re x" "Re x < 1"
    using ‹moebius_pt M v  positive_x_axis› **
    by (auto simp add: positive_x_axis_def cmod_eq_Re)
  ultimately
  have "P 0h (of_complex x)"
    using ‹is_real x axis
    by auto
  thus ?thesis
    using preserved[OF *(1) assms(1-2)] *(2) **(1)
    by simp
qed

lemma wlog_positive_x_axis:
  assumes in_disc: "u  unit_disc" "v  unit_disc" "u  v"
  assumes preserved: " M u v. unit_disc_fix M; u  unit_disc; v  unit_disc; u  v; P (moebius_pt M u) (moebius_pt M v)  P u v"
  assumes axis: " x. is_real x; 0 < Re x;  Re x < 1  P 0h (of_complex x)"
  shows "P u v"
proof-
  have "u  v  P u v" (is "?Q u v")
  proof (rule wlog_x_axis)
    show "u  unit_disc" "v  unit_disc"
      by fact+
  next
    fix M u v
    assume "unit_disc_fix M" "u  unit_disc" "v  unit_disc"
           "?Q (moebius_pt M u) (moebius_pt M v)"
    thus "?Q u v"
      using preserved[of M u v]
      using moebius_pt_invert
      by blast
  next
    fix x
    assume "is_real x" "0  Re x" "Re x < 1"
    thus "?Q 0h (of_complex x)"
      using axis[of x] of_complex_zero_iff[of x] complex.expand[of x 0]
      by fastforce
  qed
  thus ?thesis
    using u  v
    by simp
qed

(* -------------------------------------------------------------------------- *)
subsection ‹All functions that fix the unit disc›
(* -------------------------------------------------------------------------- *)

text ‹It can be proved that continuous functions that fix the unit disc are either actions of
Möbius transformations that fix the unit disc (homographies), or are compositions of actions of
Möbius transformations that fix the unit disc and the conjugation (antihomographies). We postulate
this as a definition, but it this characterisation could also be formally shown (we do not need this
for our further applications).›

definition unit_disc_fix_f where
  "unit_disc_fix_f f  
   ( M. unit_disc_fix M  (f = moebius_pt M  f = moebius_pt M  conjugate))"

text ‹Unit disc fixing functions really fix unit disc.›
lemma unit_disc_fix_f_unit_disc:
  assumes "unit_disc_fix_f M"
  shows "M ` unit_disc = unit_disc"
  using assms
  unfolding unit_disc_fix_f_def
  using image_comp
  by force

text ‹Actions of unit disc fixing Möbius transformations (unit disc fixing homographies) are unit
disc fixing functions.›
lemma unit_disc_fix_f_moebius_pt [simp]:
  assumes "unit_disc_fix M"
  shows "unit_disc_fix_f (moebius_pt M)"
  using assms
  unfolding unit_disc_fix_f_def
  by auto

text ‹Compositions of unit disc fixing Möbius transformations and conjugation (unit disc fixing
antihomographies) are unit disc fixing functions.›
lemma unit_disc_fix_conjugate_moebius [simp]:
  assumes "unit_disc_fix M"
  shows "unit_disc_fix (conjugate_moebius M)"
proof-
  have "a aa ab b. 1 < Re (a * b / (aa * ab)); ¬ 1 < Re (cnj a * cnj b / (cnj aa * cnj ab))  aa = 0"
    by (metis cnj.simps(1) complex_cnj_divide complex_cnj_mult)
  thus ?thesis
    using assms
    by (transfer, transfer)
       (auto simp add: mat_cnj_def unitary11_gen_def mat_adj_def field_simps)
qed

lemma unit_disc_fix_conjugate_comp_moebius [simp]:
  assumes "unit_disc_fix M"
  shows "unit_disc_fix_f (conjugate  moebius_pt M)"
  using assms
  apply (subst conjugate_moebius)
  apply (simp add: unit_disc_fix_f_def)
  apply (rule_tac x="conjugate_moebius M" in exI, simp)
  done


text ‹Uniti disc fixing functions form a group under function composition.›

lemma unit_disc_fix_f_comp [simp]:
  assumes "unit_disc_fix_f f1" and "unit_disc_fix_f f2"
  shows "unit_disc_fix_f (f1  f2)"
  using assms
  apply (subst (asm) unit_disc_fix_f_def)
  apply (subst (asm) unit_disc_fix_f_def)
proof safe
  fix M M'
  assume "unit_disc_fix M" "unit_disc_fix M'"
  thus "unit_disc_fix_f (moebius_pt M  moebius_pt M')"
    unfolding unit_disc_fix_f_def
    by (rule_tac x="M + M'" in exI) auto
next
  fix M M'
  assume "unit_disc_fix M" "unit_disc_fix M'"
  thus "unit_disc_fix_f (moebius_pt M  (moebius_pt M'  conjugate))"
    unfolding unit_disc_fix_f_def
    by (subst comp_assoc[symmetric])+
       (rule_tac x="M + M'" in exI, auto)
next
  fix M M'
  assume "unit_disc_fix M" "unit_disc_fix M'"
  thus "unit_disc_fix_f ((moebius_pt M  conjugate)  moebius_pt M')"
    unfolding unit_disc_fix_f_def
    by (subst comp_assoc, subst conjugate_moebius, subst comp_assoc[symmetric])+
       (rule_tac x="M + conjugate_moebius M'" in exI, auto)
next
  fix M M'
  assume "unit_disc_fix M" "unit_disc_fix M'"
  thus "unit_disc_fix_f ((moebius_pt M  conjugate)  (moebius_pt M'  conjugate))"
    apply (subst comp_assoc[symmetric], subst comp_assoc)
    apply (subst conjugate_moebius, subst comp_assoc, subst comp_assoc)
    apply (simp add: unit_disc_fix_f_def)
    apply (rule_tac x="M + conjugate_moebius M'" in exI, auto)
    done
qed

lemma unit_disc_fix_f_inv:
  assumes "unit_disc_fix_f M"
  shows "unit_disc_fix_f (inv M)"
  using assms
  apply (subst (asm) unit_disc_fix_f_def)
proof safe
  fix M
  assume "unit_disc_fix M"
  have "inv (moebius_pt M) = moebius_pt (-M)"
    by (rule ext) (simp add: moebius_inv)
  thus "unit_disc_fix_f (inv (moebius_pt M))"
    using ‹unit_disc_fix M
    unfolding unit_disc_fix_f_def
    by (rule_tac x="-M" in exI, simp)
next
  fix M
  assume "unit_disc_fix M"
  have "inv (moebius_pt M  conjugate) = conjugate  inv (moebius_pt M)"
    by (subst o_inv_distrib, simp_all)
  also have "... = conjugate  (moebius_pt (-M))"
    using moebius_inv
    by auto
  also have "... = moebius_pt (conjugate_moebius (-M))  conjugate"
    by (simp add: conjugate_moebius)
  finally
  show "unit_disc_fix_f (inv (moebius_pt M  conjugate))"
    using ‹unit_disc_fix M
    unfolding unit_disc_fix_f_def
    by (rule_tac x="conjugate_moebius (-M)" in exI, simp)
qed

(* -------------------------------------------------------------------------- *)
subsubsection ‹Action of unit disc fixing functions on circlines›
(* -------------------------------------------------------------------------- *)

definition unit_disc_fix_f_circline where
  "unit_disc_fix_f_circline f H = 
      (if  M. unit_disc_fix M  f = moebius_pt M then
          moebius_circline (THE M. unit_disc_fix M  f = moebius_pt M) H
       else if  M. unit_disc_fix M  f = moebius_pt M  conjugate then
          (moebius_circline (THE M. unit_disc_fix M  f = moebius_pt M  conjugate)  conjugate_circline) H
       else
          H)"


lemma unique_moebius_pt_conjugate:
  assumes "moebius_pt M1  conjugate = moebius_pt M2  conjugate"
  shows "M1 = M2"
proof-               
  from assms have "moebius_pt M1 = moebius_pt M2"
    using conjugate_conjugate_comp rewriteL_comp_comp2 by fastforce
  thus ?thesis
    using unique_moebius_pt
    by auto
qed

lemma unit_disc_fix_f_circline_direct:
  assumes "unit_disc_fix M" and "f = moebius_pt M"
  shows "unit_disc_fix_f_circline f H = moebius_circline M H"
proof-
  have "M = (THE M. unit_disc_fix M  f = moebius_pt M)"
    using assms
    using theI_unique[of "λ M. unit_disc_fix M  f = moebius_pt M" M]
    using unique_moebius_pt[of M]
    by auto
  thus ?thesis
    using assms
    unfolding unit_disc_fix_f_circline_def
    by auto
qed

lemma unit_disc_fix_f_circline_indirect:
  assumes "unit_disc_fix M" and "f = moebius_pt M  conjugate"
  shows "unit_disc_fix_f_circline f H = ((moebius_circline M)  conjugate_circline) H"
proof-
  have "¬ ( M. unit_disc_fix M  f = moebius_pt M)"
    using assms homography_antihomography_exclusive[of f]
    unfolding is_homography_def is_antihomography_def is_moebius_def
    by auto
  moreover
  have "M = (THE M. unit_disc_fix M  f = moebius_pt M  conjugate)"
    using assms
    using theI_unique[of "λ M. unit_disc_fix M  f = moebius_pt M  conjugate" M]
    using unique_moebius_pt_conjugate[of M] 
    by auto
  ultimately
  show ?thesis
    using assms
    unfolding unit_disc_fix_f_circline_def
    by metis
qed

text ‹Disc automorphisms - it would be nice to show that there are no disc automorphisms other than
unit disc fixing homographies and antihomographies, but this part of the theory is not yet
developed.›

definition is_disc_aut where "is_disc_aut f  bij_betw f unit_disc unit_disc"

end

Theory Riemann_Sphere

(* ---------------------------------------------------------------------------- *)
section ‹Riemann sphere›
(* ---------------------------------------------------------------------------- *)

text ‹The extended complex plane $\mathbb{C}P^1$ can be identified with a Riemann (unit) sphere
$\Sigma$ by means of stereographic projection. The sphere is projected from its north pole $N$ to
the $xOy$ plane (identified with $\mathbb{C}$). This projection establishes a bijective map $sp$
between $\Sigma \setminus \{N\}$ and the finite complex plane $\mathbb{C}$. The infinite point is
defined as the image of $N$.›

theory Riemann_Sphere
imports Homogeneous_Coordinates Circlines "HOL-Analysis.Product_Vector"
begin

text ‹Coordinates in $\mathbb{R}^3$›
type_synonym R3 = "real × real × real"

text ‹Type of points of $\Sigma$›
abbreviation unit_sphere where
  "unit_sphere  {(x::real, y::real, z::real). x*x + y*y + z*z = 1}"

typedef riemann_sphere = "unit_sphere"
  by (rule_tac x="(1, 0, 0)" in exI) simp

setup_lifting type_definition_riemann_sphere

lemma sphere_bounds':
  assumes "x*x + y*y + z*z = (1::real)"
  shows "-1  x  x  1"
proof-
  from assms have "x*x  1"
    by (smt real_minus_mult_self_le)
  hence "x2  12" "(- x)2  12"
    by (auto simp add: power2_eq_square)
  show "-1  x  x  1"
  proof (cases "x  0")
    case True
    thus ?thesis
      using x2  12
      by (smt power2_le_imp_le)      
  next
    case False
    thus ?thesis
      using (-x)2  12
      by (smt power2_le_imp_le)      
  qed
qed

lemma sphere_bounds:
  assumes "x*x + y*y + z*z = (1::real)"
  shows "-1  x  x  1"  "-1  y  y  1"  "-1  z  z  1"
  using assms
  using sphere_bounds'[of x y z] sphere_bounds'[of y x z] sphere_bounds'[of z x y]
  by (auto simp add: field_simps)

(* ---------------------------------------------------------------------------- *)
subsection ‹Parametrization of the unit sphere in polar coordinates›
(* ---------------------------------------------------------------------------- *)

lemma sphere_params_on_sphere:
  fixes α β :: real
  assumes "x = cos α * cos β" and "y = cos α * sin β" "z = sin α"
  shows "x*x + y*y + z*z = 1"
proof-
  have "x*x + y*y = (cos α * cos α) * (cos β * cos β) + (cos α * cos α) * (sin β * sin β)"
    using assms
    by simp
  hence "x*x + y*y = cos α * cos α"
    using sin_cos_squared_add3[of β]
    by (subst (asm) distrib_left[symmetric]) (simp add: field_simps)
  thus ?thesis
    using assms
    using sin_cos_squared_add3[of α]
    by simp
qed

lemma sphere_params:
  fixes x y z :: real
  assumes "x*x + y*y + z*z = 1"
  shows "x = cos (arcsin z) * cos (atan2 y x)  y = cos (arcsin z) * sin (atan2 y x)  z = sin (arcsin z)"
proof (cases "z=1  z = -1")
  case True
  hence "x = 0  y = 0"
    using assms
    by auto
  thus ?thesis
    using z = 1  z = -1
    by (auto simp add: cos_arcsin)
next
  case False
  hence "x  0  y  0"
    using assms
    by (auto simp add: square_eq_1_iff)
  thus ?thesis
    using real_sqrt_unique[of y "1 - z*z"]
    using real_sqrt_unique[of "-y" "1 - z*z"]
    using sphere_bounds[OF assms] assms
    by (auto simp add: cos_arcsin cos_arctan sin_arctan power2_eq_square field_simps real_sqrt_divide atan2_def)
qed

lemma ex_sphere_params:
  assumes "x*x + y*y + z*z = 1"
  shows " α β. x = cos α * cos β  y = cos α * sin β  z = sin α  -pi / 2  α  α  pi / 2  -pi  β  β < pi"
using assms arcsin_bounded[of z] sphere_bounds[of x y z]
by (rule_tac x="arcsin z" in exI, rule_tac x="atan2 y x" in exI) (simp add: sphere_params arcsin_bounded atan2_bounded)

(* ----------------------------------------------------------------- *)
subsection ‹Stereographic and inverse stereographic projection›
(* ----------------------------------------------------------------- *)

text ‹Stereographic projection›

definition stereographic_r3_cvec :: "R3  complex_vec" where
[simp]: "stereographic_r3_cvec M = (let (x, y, z) =  M in
     (if (x, y, z)  (0, 0, 1) then
           (x + 𝗂 * y, cor (1 - z))
      else
           (1, 0)
     ))"


lift_definition stereographic_r3_hcoords :: "R3  complex_homo_coords" is stereographic_r3_cvec
  by (auto split: if_split_asm simp add: cor_eq_0)

lift_definition stereographic :: "riemann_sphere  complex_homo" is stereographic_r3_hcoords
  done

text ‹Inverse stereographic projection›

definition inv_stereographic_cvec_r3 :: "complex_vec  R3" where [simp]:
  "inv_stereographic_cvec_r3 z = (
     let (z1, z2) = z
       in if z2 = 0 then
              (0, 0, 1)
          else
             let z = z1/z2;
                 X = Re (2*z / (1 + z*cnj z));
                 Y = Im (2*z / (1 + z*cnj z));
                 Z = ((cmod z)2 - 1) / (1 + (cmod z)2)
               in (X, Y, Z))"

lemma Re_stereographic:
  shows "Re (2 * z / (1 + z * cnj z)) = 2 * Re z / (1 + (cmod z)2)"
  using one_plus_square_neq_zero
  by (subst complex_mult_cnj_cmod, subst Re_divide_real) (auto simp add: power2_eq_square)

lemma Im_stereographic: 
  shows "Im (2 * z / (1 + z * cnj z)) = 2 * Im z / (1 + (cmod z)2)"
  using one_plus_square_neq_zero
  by (subst complex_mult_cnj_cmod, subst Im_divide_real) (auto simp add: power2_eq_square)

lemma inv_stereographic_on_sphere:
  assumes "X = Re (2*z / (1 + z*cnj z))" and "Y = Im (2*z / (1 + z*cnj z))" and "Z = ((cmod z)2 - 1) / (1 + (cmod z)2)"
  shows "X*X + Y*Y + Z*Z = 1"
proof-
  have "1 + (cmod z)2  0"
    by (smt power2_less_0)
  thus ?thesis
    using assms
    by (simp add: Re_stereographic Im_stereographic)
       (cases z, simp add: power2_eq_square real_sqrt_mult[symmetric] add_divide_distrib[symmetric], simp add: complex_norm power2_eq_square field_simps)
qed

lift_definition inv_stereographic_hcoords_r3 :: "complex_homo_coords  R3" is inv_stereographic_cvec_r3
  done

lift_definition inv_stereographic :: "complex_homo  riemann_sphere" is inv_stereographic_hcoords_r3
proof transfer
  fix v v'
  assume 1: "v  vec_zero" "v'  vec_zero" "v v v'"
  obtain v1 v2 v'1 v'2 where *: "v = (v1, v2)" "v' = (v'1, v'2)"
    by (cases v, cases v', auto)
  obtain x y z where
    **: "inv_stereographic_cvec_r3 v = (x, y, z)"
    by (cases "inv_stereographic_cvec_r3 v", blast)
  have "inv_stereographic_cvec_r3 v  unit_sphere"
  proof (cases "v2 = 0")
    case True
    thus ?thesis
      using *
      by simp
  next
    case False
    thus ?thesis
      using * ** inv_stereographic_on_sphere[of x "v1 / v2" y z]
      by (simp add: norm_divide)
  qed
  moreover
  have "inv_stereographic_cvec_r3 v = inv_stereographic_cvec_r3 v'"
    using 1 * **
    by (auto split: if_split if_split_asm)
  ultimately
  show "inv_stereographic_cvec_r3 v  unit_sphere 
        inv_stereographic_cvec_r3 v = inv_stereographic_cvec_r3 v'"
    by simp
qed

text ‹North pole›
definition North_R3 :: R3 where
  [simp]: "North_R3 = (0, 0, 1)"
lift_definition North :: "riemann_sphere" is North_R3
  by simp

lemma stereographic_North: 
  shows "stereographic x = h  x = North"
  by (transfer, transfer, auto split: if_split_asm)

text ‹Stereographic and inverse stereographic projection are mutually inverse.›

lemma stereographic_inv_stereographic':
  assumes
  z: "z = z1/z2" and "z2  0" and
  X: "X = Re (2*z / (1 + z*cnj z))" and Y: "Y = Im (2*z / (1 + z*cnj z))" and Z: "Z = ((cmod z)2 - 1) / (1 + (cmod z)2)"
  shows " k. k  0  (X + 𝗂*Y, complex_of_real (1 - Z)) = k *sv (z1, z2)"
proof-
  have "1 + (cmod z)2  0"
    by (metis one_power2 sum_power2_eq_zero_iff zero_neq_one)
  hence "(1 - Z) = 2 / (1 + (cmod z)2)"
    using Z
    by (auto simp add: field_simps)
  hence "cor (1 - Z) = 2 / cor (1 + (cmod z)2)"
    by auto
  moreover
  have "X = 2 * Re(z) / (1 + (cmod z)2)"
    using X
    by (simp add: Re_stereographic)
  have "Y = 2 * Im(z) / (1 + (cmod z)2)"
    using Y
    by (simp add: Im_stereographic)
  have "X + 𝗂*Y = 2 * z / cor (1 + (cmod z)2)"
    using 1 + (cmod z)2  0
    unfolding Complex_eq[of X Y, symmetric]
    by (subst X = 2*Re(z) / (1 + (cmod z)2), subst Y = 2*Im(z) / (1 + (cmod z)2), simp add: Complex_scale4 Complex_scale1)
  moreover
  have "1 + (cor (cmod (z1 / z2)))2  0"
    by (rule one_plus_square_neq_zero)
  ultimately
  show ?thesis
    using z2  0 1 + (cmod z)2  0
    by (simp, subst z)+
       (rule_tac x="(2 / (1 + (cor (cmod (z1 / z2)))2)) / z2" in exI, auto)
qed

lemma stereographic_inv_stereographic [simp]:
  shows "stereographic (inv_stereographic w) = w"
proof-
  have "w = stereographic (inv_stereographic w)"
  proof (transfer, transfer)
    fix w
    assume "w  vec_zero"
    obtain w1 w2 where *: "w = (w1, w2)"
      by (cases w, auto)
    obtain x y z where **: "inv_stereographic_cvec_r3 w = (x, y, z)"
      by (cases "inv_stereographic_cvec_r3 w", blast)
    show "w v stereographic_r3_cvec (inv_stereographic_cvec_r3 w)"
      using w  vec_zero› stereographic_inv_stereographic'[of "w1/w2" w1 w2 x y z] * **
      by (auto simp add: split_def Let_def split: if_split_asm)
  qed
  thus ?thesis
    by simp
qed

text ‹Stereographic projection is bijective function›

lemma bij_stereographic:
  shows "bij stereographic"
  unfolding bij_def inj_on_def surj_def
proof (safe)
  fix a b
  assume "stereographic a = stereographic b"
  thus "a = b"
  proof (transfer, transfer)
    fix a b :: R3
    obtain xa ya za xb yb zb where
      *: "a = (xa, ya, za)" "b = (xb, yb, zb)"
      by (cases a, cases b, auto)
    assume **: "a  unit_sphere" "b  unit_sphere" "stereographic_r3_cvec a v stereographic_r3_cvec b"
    show "a = b"
    proof (cases "a = (0, 0, 1)  b = (0, 0, 1)")
      case True
      thus ?thesis
        using * **
        by (simp split: if_split_asm) force+
    next
      case False
      then obtain k where ++: "k  0" "cor xb + 𝗂 * cor yb = k * (cor xa + 𝗂 * cor ya)" "1 - cor zb = k * (1 - cor za)"
        using * **
        by (auto split: if_split_asm)

      {
          assume "xb + xa*zb = xa + xb*za"
                 "yb + ya*zb = ya + yb*za"
                 "xa*xa + ya*ya + za*za = 1" "xb*xb + yb*yb + zb*zb = 1"
                 "za  1" "zb  1"
          hence "xa = xb  ya = yb  za = zb"
            by algebra
      } note *** = this

      have "za  1" "zb  1"
        using False * **
        by auto
      have "k = (1 - cor zb) / (1 - cor za)"
        using 1 - cor zb = k * (1 - cor za) za  1
        by simp
      hence "(1 - cor za) * (cor xb + 𝗂 * cor yb) = (1 - cor zb) * (cor xa + 𝗂 * cor ya)"
        using za  1 ++(2)
        by simp
      hence "xb + xa*zb = xa + xb*za"
            "yb + ya*zb = ya + yb*za"
            "xa*xa + ya*ya + za*za = 1" "xb*xb + yb*yb + zb*zb = 1"
        using * ** za  1
        apply (simp_all add: field_simps)
        unfolding complex_of_real_def imaginary_unit.ctr
        by (simp_all add: legacy_Complex_simps)
      thus ?thesis
          using * ** *** za  1 zb  1
          by simp
      qed
  qed
next
  fix y
  show " x. y = stereographic x"
    by (rule_tac x="inv_stereographic y" in exI, simp)
qed


lemma inv_stereographic_stereographic [simp]: 
  shows "inv_stereographic (stereographic x) = x"
  using stereographic_inv_stereographic[of "stereographic x"]
  using bij_stereographic
  unfolding bij_def inj_on_def
  by simp

lemma inv_stereographic_is_inv:
  shows "inv_stereographic = inv stereographic"
  by (rule inv_equality[symmetric], simp_all)

(* ----------------------------------------------------------------- *)
subsection ‹Circles on the sphere›
(* ----------------------------------------------------------------- *)

text ‹Circlines in the plane correspond to circles on the Riemann sphere, and we formally establish
this connection. Every circle in three--dimensional space can be obtained as the intersection of a
sphere and a plane. We establish a one-to-one correspondence between circles on the Riemann sphere
and planes in space. Note that the plane need not intersect the sphere, but we will still say that
it defines a single imaginary circle. However, for one special circline (the one with the identity
representative matrix), there does not exist a plane in $\mathbb{R}^3$ that would correspond to it
--- in order to have this, instead of considering planes in $\mathbb{R}^3$, we must consider three
dimensional projective space and consider the infinite (hyper)plane.›

text ‹Planes in $R^3$ are given by equations $ax+by+cz=d$. Two four-tuples of coefficients $(a, b, c,
d)$ give the same plane iff they are proportional.›

type_synonym R4 = "real × real × real × real"

fun mult_sv :: "real  R4  R4" (infixl "*sv4" 100) where
  "k *sv4 (a, b, c, d) = (k*a, k*b, k*c, k*d)"

abbreviation plane_vectors where
  "plane_vectors  {(a::real, b::real, c::real, d::real). a  0  b  0  c  0  d  0}"

typedef plane_vec = "plane_vectors"
  by (rule_tac x="(1, 1, 1, 1)" in exI) simp

setup_lifting type_definition_plane_vec

definition plane_vec_eq_r4 :: "R4  R4  bool" where
  [simp]: "plane_vec_eq_r4 v1 v2  ( k. k  0  v2 = k *sv4 v1)"

lift_definition plane_vec_eq :: "plane_vec  plane_vec  bool" is plane_vec_eq_r4
  done

lemma mult_sv_one [simp]:
  shows "1 *sv4 x = x"
  by (cases x) simp

lemma mult_sv_distb [simp]:
  shows "x *sv4 (y *sv4 v) = (x*y) *sv4 v"
  by (cases v) simp

quotient_type plane = plane_vec / plane_vec_eq
proof (rule equivpI)
  show "reflp plane_vec_eq"
    unfolding reflp_def
    by (auto simp add: plane_vec_eq_def) (rule_tac x="1" in exI, simp)
next
  show "symp plane_vec_eq"
    unfolding symp_def
    by (auto simp add: plane_vec_eq_def) (rule_tac x="1/k" in exI, simp)
next
  show "transp plane_vec_eq"
    unfolding transp_def
    by (auto simp add: plane_vec_eq_def) (rule_tac x="ka*k" in exI, simp)
qed

text ‹Plane coefficients give a linear equation and the point on the Riemann sphere lies on the
circle determined by the plane iff its representation satisfies that linear equation.›

definition on_sphere_circle_r4_r3 :: "R4  R3  bool" where
  [simp]: "on_sphere_circle_r4_r3 α A 
      (let (X, Y, Z) = A;
           (a, b, c, d) = α
        in a*X + b*Y + c*Z + d = 0)"

lift_definition on_sphere_circle_vec :: "plane_vec  R3  bool" is on_sphere_circle_r4_r3
  done

lift_definition on_sphere_circle :: "plane  riemann_sphere  bool" is on_sphere_circle_vec
proof (transfer)
  fix pv1 pv2 :: R4 and w :: R3
  obtain a1 b1 c1 d1 a2 b2 c2 d2 x y z where
    *: "pv1 = (a1, b1, c1, d1)" "pv2 = (a2, b2, c2, d2)" "w = (x, y, z)"
    by (cases pv1, cases pv2, cases w, auto)
  assume "pv1  plane_vectors" "pv2  plane_vectors" "w  unit_sphere" "plane_vec_eq_r4 pv1 pv2"
  then obtain k where **: "a2 = k*a1" "b2 = k*b1" "c2 = k*c1" "d2 = k*d1" "k  0"
    using *
    by auto
  have "k * a1 * x + k * b1 * y + k * c1 * z + k * d1 = k*(a1*x + b1*y + c1*z + d1)"
    by (simp add: field_simps)
  thus "on_sphere_circle_r4_r3 pv1 w = on_sphere_circle_r4_r3 pv2 w"
    using * **
    by simp
qed

definition sphere_circle_set where
  "sphere_circle_set α = {A. on_sphere_circle α A}"


(* ----------------------------------------------------------------- *)
subsection ‹Connections of circlines in the plane and circles on the Riemann sphere›
(* ----------------------------------------------------------------- *)

text ‹We introduce stereographic and inverse stereographic projection between circles on the Riemann
sphere and circlines in the extended complex plane.›

definition inv_stereographic_circline_cmat_r4 :: "complex_mat  R4" where
  [simp]: "inv_stereographic_circline_cmat_r4 H  =
            (let (A, B, C, D) = H
              in (Re (B+C), Re(𝗂*(C-B)), Re(A-D), Re(D+A)))"

lift_definition inv_stereographic_circline_clmat_pv :: "circline_mat  plane_vec" is inv_stereographic_circline_cmat_r4
  by (auto simp add: hermitean_def mat_adj_def mat_cnj_def real_imag_0 eq_cnj_iff_real)

lift_definition inv_stereographic_circline :: "circline  plane" is inv_stereographic_circline_clmat_pv
  apply transfer
  apply simp
  apply (erule exE)
  apply (rule_tac x="k" in exI)
  apply (case_tac "circline_mat1", case_tac "circline_mat2")
  apply (simp add: field_simps)
  done

definition stereographic_circline_r4_cmat :: "R4  complex_mat" where
[simp]: "stereographic_circline_r4_cmat α =
         (let (a, b, c, d) = α
           in (cor ((c+d)/2) , ((cor a + 𝗂 * cor b)/2), ((cor a - 𝗂 * cor b)/2), cor ((d-c)/2)))"

lift_definition stereographic_circline_pv_clmat :: "plane_vec  circline_mat" is stereographic_circline_r4_cmat
  by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)

lift_definition stereographic_circline :: "plane  circline" is stereographic_circline_pv_clmat
  apply transfer
  apply transfer
  apply (case_tac plane_vec1, case_tac plane_vec2, simp, erule exE, rule_tac x=k in exI, simp add: field_simps)
  done

text ‹Stereographic and inverse stereographic projection of circlines are mutually inverse.›

lemma stereographic_circline_inv_stereographic_circline:
  shows "stereographic_circline  inv_stereographic_circline = id"
proof (rule ext, simp)
  fix H
  show "stereographic_circline (inv_stereographic_circline H) = H"
  proof (transfer, transfer)
    fix H
    assume hh: "hermitean H  H  mat_zero"
    obtain A B C D where HH: "H = (A, B, C, D)"
      by (cases "H") auto
    have "is_real A" "is_real D" "C = cnj B"
      using HH hh hermitean_elems[of A B C D]
      by auto
    thus "circline_eq_cmat (stereographic_circline_r4_cmat (inv_stereographic_circline_cmat_r4 H)) H"
      using HH
      apply simp
      apply (rule_tac x=1 in exI, cases B)
      by (smt add_uminus_conv_diff complex_cnj_add complex_cnj_complex_of_real complex_cnj_i complex_cnj_mult complex_cnj_one complex_eq distrib_left_numeral mult.commute mult.left_commute mult.left_neutral mult_cancel_right2 mult_minus_left of_real_1 one_add_one)
  qed
qed

text ‹Stereographic and inverse stereographic projection of circlines are mutually inverse.›
lemma inv_stereographic_circline_stereographic_circline:
  "inv_stereographic_circline  stereographic_circline = id"
proof (rule ext, simp)
  fix α
  show "inv_stereographic_circline (stereographic_circline α) = α"
  proof (transfer, transfer)
    fix α
    assume aa: "α  plane_vectors"
    obtain a b c d where AA: "α = (a, b, c, d)"
      by (cases "α") auto
    thus "plane_vec_eq_r4 (inv_stereographic_circline_cmat_r4 (stereographic_circline_r4_cmat α)) α"
      using AA
      by simp (rule_tac x=1 in exI, auto simp add: field_simps complex_of_real_def)
  qed
qed

lemma stereographic_sphere_circle_set'':
  shows "on_sphere_circle (inv_stereographic_circline H) z 
         on_circline H (stereographic z)"
proof (transfer, transfer)
  fix M :: R3 and H :: complex_mat
  assume hh: "hermitean H  H  mat_zero" "M  unit_sphere"
  obtain A B C D where HH: "H = (A, B, C, D)"
    by (cases "H") auto
  have *: "is_real A" "is_real D" "C = cnj B"
    using hh HH hermitean_elems[of A B C D]
    by auto
  obtain x y z where MM: "M = (x, y, z)"
    by (cases "M") auto
  show "on_sphere_circle_r4_r3 (inv_stereographic_circline_cmat_r4 H) M 
        on_circline_cmat_cvec H (stereographic_r3_cvec M)" (is "?lhs = ?rhs")
  proof
    assume ?lhs
    show ?rhs
    proof (cases "z=1")
      case True
      hence "x = 0" "y = 0"
        using MM hh
        by auto
      thus ?thesis
        using * ?lhs HH MM z=1
        by (cases A, simp add: vec_cnj_def Complex_eq Let_def)
    next
      case False
      hence "Re A*(1+z) + 2*Re B*x + 2*Im B*y + Re D*(1-z) = 0"
        using * ?lhs HH MM
        by (simp add: Let_def field_simps)
      hence "(Re A*(1+z) + 2*Re B*x + 2*Im B*y + Re D*(1-z))*(1-z) = 0"
        by simp
      hence "Re A*(1+z)*(1-z) + 2*Re B*x*(1-z) + 2*Im B*y*(1-z) + Re D*(1-z)*(1-z) = 0"
        by (simp add: field_simps)
      moreover
      have "x*x+y*y = (1+z)*(1-z)"
        using MM hh
        by (simp add: field_simps)
      ultimately
      have "Re A*(x*x+y*y) + 2*Re B*x*(1-z) + 2*Im B*y*(1-z) + Re D*(1-z)*(1-z) = 0"
        by simp
      hence "(x * Re A + (1 - z) * Re B) * x - (- (y * Re A) + - ((1 - z) * Im B)) * y + (x * Re B + y * Im B + (1 - z) * Re D) * (1 - z) = 0"
        by (simp add: field_simps)
      thus ?thesis
        using z  1 HH MM * ‹Re A*(1+z) + 2*Re B*x + 2*Im B*y + Re D*(1-z) = 0
        apply (simp add: Let_def vec_cnj_def)
        apply (subst complex_eq_iff)
        apply (simp add: field_simps)
        done
    qed
  next
    assume ?rhs
    show ?lhs
    proof (cases "z=1")
      case True
      hence "x = 0" "y = 0"
        using MM hh
        by auto
      thus ?thesis
        using HH MM ?rhs z = 1
        by (simp add: Let_def vec_cnj_def)
    next
      case False
      hence "(x * Re A + (1 - z) * Re B) * x - (- (y * Re A) + - ((1 - z) * Im B)) * y + (x * Re B + y * Im B + (1 - z) * Re D) * (1 - z) = 0"
        using HH MM * ?rhs
        by (simp add: Let_def vec_cnj_def complex_eq_iff)
      hence "Re A*(x*x+y*y) + 2*Re B*x*(1-z) + 2*Im B*y*(1-z) + Re D*(1-z)*(1-z) = 0"
        by (simp add: field_simps)
      moreover
      have "x*x + y*y = (1+z)*(1-z)"
        using MM hh
        by (simp add: field_simps)
      ultimately
      have "Re A*(1+z)*(1-z) + 2*Re B*x*(1-z) + 2*Im B*y*(1-z) + Re D*(1-z)*(1-z) = 0"
        by simp
      hence "(Re A*(1+z) + 2*Re B*x + 2*Im B*y + Re D*(1-z))*(1-z) = 0"
        by (simp add: field_simps)
      hence "Re A*(1+z) + 2*Re B*x + 2*Im B*y + Re D*(1-z) = 0"
        using z  1
        by simp
      thus ?thesis
        using MM HH *
        by (simp add: field_simps)
    qed
  qed
qed

lemma stereographic_sphere_circle_set' [simp]:
  shows "stereographic ` sphere_circle_set (inv_stereographic_circline H) =
         circline_set H"
unfolding sphere_circle_set_def circline_set_def
apply safe
proof-
  fix x
  assume "on_sphere_circle (inv_stereographic_circline H) x"
  thus "on_circline H (stereographic x)"
    using stereographic_sphere_circle_set''
    by simp
next
  fix x
  assume "on_circline H x"
  show "x  stereographic ` {z. on_sphere_circle (inv_stereographic_circline H) z}"
  proof
    show "x = stereographic (inv_stereographic x)"
      by simp
  next
    show "inv_stereographic x  {z. on_sphere_circle (inv_stereographic_circline H) z}"
      using stereographic_sphere_circle_set''[of H "inv_stereographic x"] ‹on_circline H x
      by simp
  qed
qed

text ‹The projection of the set of points on a circle on the Riemann sphere is exactly the set of
points on the circline obtained by the just introduced circle stereographic projection.›
lemma stereographic_sphere_circle_set:
  shows "stereographic ` sphere_circle_set H = circline_set (stereographic_circline H)"
using stereographic_sphere_circle_set'[of "stereographic_circline H"]
using inv_stereographic_circline_stereographic_circline
unfolding comp_def
by (metis id_apply)

text ‹Stereographic projection of circlines is bijective.›
lemma bij_stereographic_circline:
  shows "bij stereographic_circline"
  using stereographic_circline_inv_stereographic_circline inv_stereographic_circline_stereographic_circline
  using o_bij by blast

text ‹Inverse stereographic projection is bijective.›
lemma bij_inv_stereographic_circline:
  shows "bij inv_stereographic_circline"
  using stereographic_circline_inv_stereographic_circline inv_stereographic_circline_stereographic_circline
  using o_bij by blast

end

Theory Chordal_Metric

(* -------------------------------------------------------------------------- *)
subsection ‹Chordal Metric›
(* -------------------------------------------------------------------------- *)

text ‹Riemann sphere can be made a metric space. We are going to introduce distance on Riemann sphere
and to prove that it is a metric space. The distance between two points on the sphere is defined as
the length of the chord that connects them. This metric can be used in formalization of elliptic
geometry.›

theory Chordal_Metric
  imports Homogeneous_Coordinates Riemann_Sphere Oriented_Circlines "HOL-Analysis.Inner_Product" "HOL-Analysis.Euclidean_Space"
begin

(* -------------------------------------------------------------------------- *)
subsubsection ‹Inner product and norm›
(* -------------------------------------------------------------------------- *)

definition inprod_cvec :: "complex_vec  complex_vec  complex" where
 [simp]: "inprod_cvec z w =
             (let (z1, z2) = z;
                  (w1, w2) = w
               in vec_cnj (z1, z2) *vv (w1, w2))"
syntax
  "_inprod_cvec" :: "complex_vec  complex_vec  complex"  ("_,_")
translations
  "z,w" == "CONST inprod_cvec z w"

lemma real_inprod_cvec [simp]:
  shows "is_real z,z"
  by (cases z, simp add: vec_cnj_def)

lemma inprod_cvec_ge_zero [simp]:
  shows "Re z,z  0"
  by (cases z, simp add: vec_cnj_def)

lemma inprod_cvec_bilinear1 [simp]:
  assumes "z' = k *sv  z"
  shows "z',w = cnj k * z,w"
  using assms
  by (cases z, cases z', cases w) (simp add: vec_cnj_def field_simps)

lemma inprod_cvec_bilinear2 [simp]:
  assumes "z' = k *sv z"
  shows "w, z' = k * w, z"
  using assms
  by (cases z, cases z', cases w) (simp add: vec_cnj_def field_simps)

lemma inprod_cvec_g_zero [simp]:
  assumes "z  vec_zero"
  shows "Re z, z > 0"
proof-
  have " a b. a  0  b  0  0 < (Re a * Re a + Im a * Im a) + (Re b * Re b + Im b * Im b)"
    by (smt complex_eq_0 not_sum_squares_lt_zero power2_eq_square)
  thus ?thesis
    using assms
    by (cases z, simp add: vec_cnj_def)
qed

definition norm_cvec :: "complex_vec  real" where
  [simp]: "norm_cvec z = sqrt (Re z,z)"
syntax
  "_norm_cvec" :: "complex_vec  complex"  ("_")
translations
  "z" == "CONST norm_cvec z"

lemma norm_cvec_square:
  shows "z2 = Re (z,z)"
  by (simp del: inprod_cvec_def)

lemma norm_cvec_gt_0:
  assumes "z  vec_zero"
  shows "z > 0"
  using assms
  by (simp del: inprod_cvec_def)

lemma norm_cvec_scale:
  assumes "z' = k *sv z"
  shows "z'2 = Re (cnj k * k) * z2"
  unfolding norm_cvec_square
  using inprod_cvec_bilinear1[OF assms, of z']
  using inprod_cvec_bilinear2[OF assms, of z]
  by (simp del: inprod_cvec_def add: field_simps)

lift_definition inprod_hcoords :: "complex_homo_coords  complex_homo_coords  complex" is inprod_cvec
  done

lift_definition norm_hcoords :: "complex_homo_coords  real" is norm_cvec
  done

(* -------------------------------------------------------------------------- *)
subsubsection ‹Distance in $\mathbb{C}P^1$ - defined by Fubini-Study metric.›
(* -------------------------------------------------------------------------- *)

text ‹Formula for the chordal distance between the two points can be given directly based
on the homogenous coordinates of their stereographic projections in the plane. This is
called the Fubini-Study metric.›

definition dist_fs_cvec :: "complex_vec  complex_vec  real" where [simp]:
  "dist_fs_cvec z1 z2 =
     (let (z1x, z1y) = z1;
          (z2x, z2y) = z2;
          num = (z1x*z2y - z2x*z1y) * (cnj z1x*cnj z2y - cnj z2x*cnj z1y);
          den = (z1x*cnj z1x + z1y*cnj z1y) * (z2x*cnj z2x + z2y*cnj z2y)
       in 2*sqrt(Re num / Re den))"

lemma dist_fs_cvec_iff:
  assumes "z  vec_zero" and "w  vec_zero"
  shows "dist_fs_cvec z w = 2*sqrt(1 - (cmod z,w)2 / (z2 * w2))"
proof-
  obtain z1 z2 w1 w2 where *: "z = (z1, z2)" "w = (w1, w2)"
    by (cases "z", cases "w") auto
  have 1: "2*sqrt(1 - (cmod z,w)2 / (z2 * w2)) = 2*sqrt((z2 * w2 - (cmod z,w)2) / (z2 * w2))"
    using norm_cvec_gt_0[of z] norm_cvec_gt_0[of w] assms
    by (simp add: field_simps)

  have 2: "z2 * w2 = Re ((z1*cnj z1 + z2*cnj z2) * (w1*cnj w1 + w2*cnj w2))"
    using assms *
    by (simp add: vec_cnj_def)

  have 3: "z2 * w2 - (cmod z,w)2 = Re ((z1*w2 - w1*z2) * (cnj z1*cnj w2 - cnj w1*cnj z2))"
    apply (subst cmod_square, (subst norm_cvec_square)+)
    using *
    by (simp add: vec_cnj_def field_simps)

  thus ?thesis
    using 1 2 3
    using *
    unfolding dist_fs_cvec_def Let_def
    by simp
qed

lift_definition dist_fs_hcoords :: "complex_homo_coords  complex_homo_coords  real" is dist_fs_cvec
  done

lift_definition dist_fs :: "complex_homo  complex_homo  real" is dist_fs_hcoords
proof transfer
  fix z1 z2 z1' z2' :: complex_vec
  obtain z1x z1y z2x z2y z1'x z1'y z2'x z2'y where
    zz: "z1 = (z1x, z1y)" "z2 = (z2x, z2y)" "z1' = (z1'x, z1'y)" "z2' = (z2'x, z2'y)"
    by (cases "z1", cases "z2", cases "z1'", cases "z2'") blast

  assume 1: "z1  vec_zero" "z2  vec_zero" "z1'  vec_zero" "z2'  vec_zero" "z1 v z1'" "z2 v z2'"
  then obtain k1 k2 where
    *: "k1  0" "z1' = k1 *sv z1" and
    **: "k2  0" "z2' = k2 *sv z2"
    by auto
  have "(cmod z1,z2)2 / (z12 * z22) = (cmod z1',z2')2 / (z1'2 * z2'2)"
    using k1  0 k2  0
    using cmod_square[symmetric, of k1] cmod_square[symmetric, of k2]
    apply (subst norm_cvec_scale[OF *(2)])
    apply (subst norm_cvec_scale[OF **(2)])
    apply (subst inprod_cvec_bilinear1[OF *(2)])
    apply (subst inprod_cvec_bilinear2[OF **(2)])
    by (simp add: power2_eq_square norm_mult)
  thus "dist_fs_cvec z1 z2 = dist_fs_cvec z1' z2'"
    using 1 dist_fs_cvec_iff
    by simp
qed

lemma dist_fs_finite:
  shows "dist_fs (of_complex z1) (of_complex z2) = 2 * cmod(z1 - z2) / (sqrt (1+(cmod z1)2) * sqrt (1+(cmod z2)2))"
  apply transfer
  apply transfer
  apply (subst cmod_square)+
  apply (simp add: real_sqrt_divide cmod_def power2_eq_square)
  apply (subst real_sqrt_mult[symmetric])
  apply (simp add: field_simps)
  done

lemma dist_fs_infinite1:
  shows "dist_fs (of_complex z1) h = 2 / sqrt (1+(cmod z1)2)"
  by (transfer, transfer) (subst cmod_square, simp add: real_sqrt_divide)

lemma dist_fs_infinite2:
  shows "dist_fs h (of_complex z1) = 2 / sqrt (1+(cmod z1)2)"
  by (transfer, transfer) (subst cmod_square, simp add: real_sqrt_divide)

lemma dist_fs_cvec_zero:
  assumes "z  vec_zero" and "w  vec_zero"
  shows  "dist_fs_cvec z w = 0  (cmod z,w)2 = (z2 * w2)"
  using assms norm_cvec_gt_0[of z]  norm_cvec_gt_0[of w]
  by (subst dist_fs_cvec_iff) auto

lemma dist_fs_zero1 [simp]:
  shows "dist_fs z z = 0"
  by (transfer, transfer)
     (subst dist_fs_cvec_zero, simp, (subst norm_cvec_square)+, subst cmod_square, simp del: inprod_cvec_def)

lemma dist_fs_zero2 [simp]:
  assumes "dist_fs z1 z2 = 0"
  shows "z1 = z2"
  using assms
proof (transfer, transfer)
  fix z w :: complex_vec
  obtain z1 z2 w1 w2 where *: "z = (z1, z2)" "w = (w1, w2)"
    by (cases "z", cases "w", auto)
  let ?x = "(z1*w2 - w1*z2) * (cnj z1*cnj w2 - cnj w1*cnj z2)"
  assume "z  vec_zero" "w  vec_zero" "dist_fs_cvec z w = 0"
  hence "(cmod z,w)2 = z2 * w2"
    by (subst (asm) dist_fs_cvec_zero, simp_all)
  hence "Re ?x = 0"
    using *
    by (subst (asm) cmod_square) ((subst (asm) norm_cvec_square)+, simp add: vec_cnj_def field_simps)
  hence "?x = 0"
    using complex_mult_cnj_cmod[of "z1*w2 - w1*z2"] zero_complex.simps
    by (subst complex_eq_if_Re_eq[of ?x 0]) (simp add: power2_eq_square, simp, linarith)
  moreover
  have "z1 * w2 - w1 * z2 = 0  cnj z1 * cnj w2 - cnj w1 * cnj z2 = 0"
    by (metis complex_cnj_diff complex_cnj_mult complex_cnj_zero_iff)
  ultimately
  show "z v w"
    using * z  vec_zero› w  vec_zero›
    using complex_cvec_eq_mix[of z1 z2 w1 w2]
    by auto
qed

lemma dist_fs_sym:
  shows "dist_fs z1 z2 = dist_fs z2 z1"
  by (transfer, transfer) (simp add: split_def field_simps)

(* -------------------------------------------------------------------------- *)
subsubsection ‹Triangle inequality for Fubini-Study metric›
(* -------------------------------------------------------------------------- *)

lemma dist_fs_triangle_finite:
  shows "cmod(a - b) / (sqrt (1+(cmod a)2) * sqrt (1+(cmod b)2))  cmod (a - c) / (sqrt (1+(cmod a)2) * sqrt (1+(cmod c)2)) + cmod (c - b) / (sqrt (1+(cmod b)2) * sqrt (1+(cmod c)2))"
proof-
  let ?cc = "1+(cmod c)2" and ?bb = "1+(cmod b)2" and ?aa = "1+(cmod a)2"
  have "sqrt ?cc > 0" "sqrt ?aa > 0" "sqrt ?bb > 0"
    by (smt real_sqrt_gt_zero zero_compare_simps(12))+
  have "(a - b)*(1+cnj c*c) = (a-c)*(1+cnj c*b) + (c-b)*(1 + cnj c*a)"
    by (simp add: field_simps)
  moreover
  have "1 + cnj c * c = 1 + (cmod c)2"
    using complex_norm_square
    by auto
  hence "cmod ((a - b)*(1+cnj c*c)) = cmod(a - b) * (1+(cmod c)2)"
    by (smt norm_mult norm_of_real zero_compare_simps(12))
  ultimately
  have "cmod(a - b) * (1+(cmod c)2)  cmod (a-c) * cmod (1+cnj c*b) + cmod (c-b) * cmod(1 + cnj c*a)"
    using complex_mod_triangle_ineq2[of "(a-c)*(1+cnj c*b)" "(c-b)*(1 + cnj c*a)"]
    by (simp add: norm_mult)
  moreover
  have *: " a b c d b' d'. b  b'; d  d'; a  (0::real); c  0  a*b + c*d  a*b' + c*d'"
    by (simp add: add_mono_thms_linordered_semiring(1) mult_left_mono)
  have "cmod (a-c) * cmod (1+cnj c*b) + cmod (c-b) * cmod(1 + cnj c*a)  cmod (a - c) * (sqrt (1+(cmod c)2) * sqrt (1+(cmod b)2)) + cmod (c - b) * (sqrt (1+(cmod c)2) * sqrt (1+(cmod a)2))"
    using *[OF cmod_1_plus_mult_le[of "cnj c" b] cmod_1_plus_mult_le[of "cnj c" a], of "cmod (a-c)" "cmod (c-b)"]
    by (simp add: field_simps real_sqrt_mult[symmetric])
  ultimately
  have "cmod(a - b) * ?cc  cmod (a - c) * sqrt ?cc * sqrt ?bb + cmod (c - b) * sqrt ?cc * sqrt ?aa"
    by simp
  moreover
  hence "0  ?cc * sqrt ?aa * sqrt ?bb"
    using mult_right_mono[of 0 "sqrt ?aa"  "sqrt ?bb"]
    using mult_right_mono[of 0 "?cc" "sqrt ?aa * sqrt ?bb"]
    by simp
  moreover
  have "sqrt ?cc / ?cc = 1 / sqrt ?cc"
    using ‹sqrt ?cc > 0
    by (simp add: field_simps)
  hence "sqrt ?cc / (?cc * sqrt ?aa) = 1 / (sqrt ?aa * sqrt ?cc)"
    using times_divide_eq_right[of "1/sqrt ?aa" "sqrt ?cc" "?cc"]
    using ‹sqrt ?aa > 0
    by simp
  hence "cmod (a - c) * sqrt ?cc / (?cc * sqrt ?aa) = cmod (a - c) / (sqrt ?aa * sqrt ?cc)"
    using times_divide_eq_right[of "cmod (a - c)" "sqrt ?cc" "(?cc * sqrt ?aa)"]
    by simp
  moreover
  have "sqrt ?cc / ?cc = 1 / sqrt ?cc"
    using ‹sqrt ?cc > 0
    by (simp add: field_simps)
  hence "sqrt ?cc / (?cc * sqrt ?bb) = 1 / (sqrt ?bb * sqrt ?cc)"
    using times_divide_eq_right[of "1/sqrt ?bb" "sqrt ?cc" "?cc"]
    using ‹sqrt ?bb > 0
    by simp
  hence "cmod (c - b) * sqrt ?cc / (?cc * sqrt ?bb) = cmod (c - b) / (sqrt ?bb * sqrt ?cc)"
    using times_divide_eq_right[of "cmod (c - b)" "sqrt ?cc" "?cc * sqrt ?bb"]
    by simp
  ultimately
  show ?thesis
    using divide_right_mono[of "cmod (a - b) * ?cc" "cmod (a - c) * sqrt ?cc * sqrt ?bb + cmod (c - b) * sqrt ?cc * sqrt ?aa" "?cc * sqrt ?aa * sqrt ?bb"] ‹sqrt ?aa > 0 ‹sqrt ?bb > 0 ‹sqrt ?cc > 0
    by (simp add: add_divide_distrib)
qed

lemma dist_fs_triangle_infinite1: 
  shows "1 / sqrt(1 + (cmod b)2)  1 / sqrt(1 + (cmod c)2) + cmod (b - c) / (sqrt(1 + (cmod b)2) * sqrt(1 + (cmod c)2))"
proof-
  let ?bb = "sqrt (1 + (cmod b)2)" and ?cc = "sqrt (1 + (cmod c)2)"
  have "?bb > 0" "?cc > 0"
    by (metis add_strict_increasing real_sqrt_gt_0_iff zero_le_power2 zero_less_one)+
  hence *: "?bb * ?cc  0"
    by simp
  have **: "(?cc - ?bb) / (?bb * ?cc) = 1 / ?bb - 1 / ?cc"
    using ‹sqrt (1 + (cmod b)2) > 0  ‹sqrt (1 + (cmod c)2) > 0
    by (simp add: field_simps)
  show "1 / ?bb  1 / ?cc + cmod (b - c) / (?bb * ?cc)"
    using divide_right_mono[OF cmod_diff_ge[of c b] *]
    by (subst (asm) **) (simp add: field_simps norm_minus_commute)
qed

lemma dist_fs_triangle_infinite2:
  shows "1 / sqrt(1 + (cmod a)2)  cmod (a - c) / (sqrt (1+(cmod a)2) * sqrt (1+(cmod c)2)) + 1 / sqrt(1 + (cmod c)2)"
  using dist_fs_triangle_infinite1[of a c]
  by simp

lemma dist_fs_triangle_infinite3:
  shows "cmod(a - b) / (sqrt (1+(cmod a)2) * sqrt (1+(cmod b)2))  1 / sqrt(1 + (cmod a)2) + 1 / sqrt(1 + (cmod b)2)"
proof-
  let ?aa = "sqrt (1 + (cmod a)2)" and ?bb = "sqrt (1 + (cmod b)2)"
  have "?aa > 0" "?bb > 0"
    by (metis add_strict_increasing real_sqrt_gt_0_iff zero_le_power2 zero_less_one)+
  hence *: "?aa * ?bb  0"
    by simp
  have **: "(?aa + ?bb) / (?aa * ?bb) = 1 / ?aa + 1 / ?bb"
    using ?aa > 0 ?bb > 0
    by (simp add: field_simps)
  show "cmod (a - b) / (?aa * ?bb)  1 / ?aa + 1 / ?bb"
    using divide_right_mono[OF cmod_diff_le[of a b] *]
    by (subst (asm) **) (simp add: field_simps norm_minus_commute)
qed

lemma dist_fs_triangle:
  shows "dist_fs A B  dist_fs A C + dist_fs C B"
proof (cases "A = h")
  case True
  show ?thesis
  proof (cases "B = h")
    case True
    show ?thesis
    proof (cases "C = h")
      case True
      show ?thesis
        using A = h B = h C = h
        by simp
    next
      case False
      then obtain c where "C = of_complex c"
        using inf_or_of_complex[of C]
        by auto
      show ?thesis
        using A = h B = h C = of_complex c
        by (simp add: dist_fs_infinite2 dist_fs_sym)
    qed
  next
    case False
    then obtain b where "B = of_complex b"
      using inf_or_of_complex[of B]
      by auto
    show ?thesis
    proof (cases "C = h")
      case True
      show ?thesis
        using A = h C = h B = of_complex b
        by simp
    next
      case False
      then obtain c where "C = of_complex c"
        using inf_or_of_complex[of C]
        by auto
      show ?thesis
        using A = h B = of_complex b C = of_complex c
        using mult_left_mono[OF dist_fs_triangle_infinite1[of b c], of 2]
        by (simp add: dist_fs_finite dist_fs_infinite1 dist_fs_infinite2 dist_fs_sym)
    qed
  qed
next
  case False
  then obtain a where "A = of_complex a"
    using inf_or_of_complex[of A]
    by auto
  show ?thesis
  proof (cases "B = h")
    case True
    show ?thesis
    proof (cases "C = h")
      case True
      show ?thesis
        using B = h C = h A = of_complex a
        by (simp add: dist_fs_infinite2)
    next
      case False
      then obtain c where "C = of_complex c"
        using inf_or_of_complex[of C]
        by auto
      show ?thesis
        using B = h C = of_complex c A = of_complex a
        using mult_left_mono[OF dist_fs_triangle_infinite2[of a c], of 2]
        by (simp add: dist_fs_finite dist_fs_infinite1 dist_fs_infinite2)
    qed
  next
    case False
    then obtain b where "B = of_complex b"
      using inf_or_of_complex[of B]
      by auto
    show ?thesis
    proof (cases "C = h")
      case True
      thus ?thesis
        using C = h B = of_complex b A = of_complex a
        using mult_left_mono[OF dist_fs_triangle_infinite3[of a b], of 2]
        by (simp add: dist_fs_finite dist_fs_infinite1 dist_fs_infinite2)
    next
      case False
      then obtain c where "C = of_complex c"
        using inf_or_of_complex[of C]
        by auto
      show ?thesis
        using A = of_complex a B = of_complex b C = of_complex c
        using mult_left_mono[OF dist_fs_triangle_finite[of a b c], of 2]
        by (simp add: dist_fs_finite norm_minus_commute dist_fs_sym)
    qed
  qed
qed

(* -------------------------------------------------------------------------- *)
subsubsection ‹$\mathbb{C}P^1$ with Fubini-Study metric is a metric space›
(* -------------------------------------------------------------------------- *)

text ‹Using the (already available) fact that $\mathbb{R}^3$ is a metric space (under the distance
function $\lambda\ x\ y.\ @{term norm}(x - y)$), it was not difficult to show that the type @{term
complex_homo} equipped with @{term dist_fs} is a metric space, i.e., an instantiation of the @{term
metric_space} locale.›

instantiation complex_homo :: metric_space
begin
definition "dist_complex_homo = dist_fs"
definition "(uniformity_complex_homo :: (complex_homo × complex_homo) filter) = (INF e{0<..}. principal {(x, y). dist_class.dist x y < e})"
definition "open_complex_homo (U :: complex_homo set) = ( x  U. eventually (λ(x', y). x' = x  y  U) uniformity)"
instance
proof
  fix x y :: complex_homo
  show "(dist_class.dist x y = 0) = (x = y)"
    unfolding dist_complex_homo_def
    using dist_fs_zero1[of x] dist_fs_zero2[of x y]
    by auto
next
  fix x y z :: complex_homo
  show "dist_class.dist x y  dist_class.dist x z + dist_class.dist y z"
    unfolding dist_complex_homo_def
    using dist_fs_triangle[of x y z]
    by (simp add: dist_fs_sym)
qed (simp_all add: open_complex_homo_def uniformity_complex_homo_def)
end

(* -------------------------------------------------------------------------- *)
subsubsection ‹Chordal distance on the Riemann sphere›
(* -------------------------------------------------------------------------- *)

text ‹Distance of the two points is given by the length of the chord. We show that it corresponds to
the Fubini-Study metric in the plane.›

definition dist_riemann_sphere_r3 :: "R3  R3  real" where [simp]:
  "dist_riemann_sphere_r3 M1 M2 =
     (let (x1, y1, z1) = M1;
          (x2, y2, z2) = M2
       in norm (x1 - x2, y1 - y2, z1 - z2))"

lemma dist_riemann_sphere_r3_inner:
  assumes "M1  unit_sphere" and "M2  unit_sphere"
  shows  "(dist_riemann_sphere_r3 M1 M2)2 = 2 - 2 * inner M1 M2"
  using assms
  apply (cases M1, cases M2)
  apply (auto simp add: norm_prod_def)
  apply (simp add: power2_eq_square field_simps)
  done


lift_definition dist_riemann_sphere' :: "riemann_sphere  riemann_sphere  real" is dist_riemann_sphere_r3
  done

lemma dist_riemann_sphere_ge_0 [simp]: 
  shows "dist_riemann_sphere' M1 M2  0"
  apply transfer
  using norm_ge_zero
  by (simp add: split_def Let_def)

text ‹Using stereographic projection we prove the connection between chordal metric on the spehere
and Fubini-Study metric in the plane.›

lemma dist_stereographic_finite:
  assumes "stereographic M1 = of_complex m1"  and "stereographic M2 = of_complex m2"
  shows "dist_riemann_sphere' M1 M2 = 2 * cmod (m1 - m2) / (sqrt (1 + (cmod m1)2) * sqrt (1 + (cmod m2)2))"
  using assms
proof-
  have *: "M1 = inv_stereographic (of_complex m1)"  "M2 = inv_stereographic (of_complex m2)"
    using inv_stereographic_is_inv assms
    by (metis inv_stereographic_stereographic)+
  have "(1 + (cmod m1)2)  0"  "(1 + (cmod m2)2)  0"
    by (smt power2_less_0)+
  have "(1 + (cmod m1)2) > 0"  "(1 + (cmod m2)2) > 0"
    by (smt realpow_square_minus_le)+
  hence "(1 + (cmod m1)2) * (1 + (cmod m2)2) > 0"
    by (metis norm_mult_less norm_zero power2_eq_square zero_power2)
  hence ++: "sqrt ((1 + cmod m1 * cmod m1) * (1 + cmod m2 * cmod m2)) > 0"
    using real_sqrt_gt_0_iff
    by (simp add: power2_eq_square)
  hence **: "(2 * cmod (m1 - m2) / sqrt ((1 + cmod m1 * cmod m1) * (1 + cmod m2 * cmod m2)))  0  cmod (m1 - m2)  0"
    by (metis diff_self divide_nonneg_pos mult_2 norm_ge_zero norm_triangle_ineq4 norm_zero)

  have "(dist_riemann_sphere' M1 M2)2 * (1 + (cmod m1)2) * (1 + (cmod m2)2) = 4 * (cmod (m1 - m2))2"
    using *
  proof (transfer, transfer)
    fix m1 m2 M1 M2
    assume us: "M1  unit_sphere" "M2  unit_sphere" and
        *: "M1 = inv_stereographic_cvec_r3 (of_complex_cvec m1)" "M2 = inv_stereographic_cvec_r3 (of_complex_cvec m2)"
    have "(1 + (cmod m1)2)  0"  "(1 + (cmod m2)2)  0"
      by (smt power2_less_0)+
    thus "(dist_riemann_sphere_r3 M1 M2)2 * (1 + (cmod m1)2) * (1 + (cmod m2)2) =
          4 * (cmod (m1 - m2))2"
      apply (subst dist_riemann_sphere_r3_inner[OF us])
      apply (subst *)+
      apply (simp add: dist_riemann_sphere_r3_inner[OF us] complex_mult_cnj_cmod)
      apply (subst left_diff_distrib[of 2])
      apply (subst left_diff_distrib[of "2*(1+(cmod m1)2)"])
      apply (subst distrib_right[of _ _ "(1 + (cmod m1)2)"])
      apply (subst distrib_right[of _ _ "(1 + (cmod m1)2)"])
      apply simp
      apply (subst distrib_right[of _ _ "(1 + (cmod m2)2)"])
      apply (subst distrib_right[of _ _ "(1 + (cmod m2)2)"])
      apply (subst distrib_right[of _ _ "(1 + (cmod m2)2)"])
      apply simp
      apply (subst (asm) cmod_square)+
      apply (subst cmod_square)+
      apply (simp add: field_simps)
      done
  qed
  hence "(dist_riemann_sphere' M1 M2)2 = 4 * (cmod (m1 - m2))2 / ((1 + (cmod m1)2) * (1 + (cmod m2)2))"
    using (1 + (cmod m1)2)  0  (1 + (cmod m2)2)  0
    using eq_divide_imp[of "(1 + (cmod m1)2) * (1 + (cmod m2)2)" "(dist_riemann_sphere' M1 M2)2" "4 * (cmod (m1 - m2))2"]
    by simp
  thus "dist_riemann_sphere' M1 M2 = 2 * cmod (m1 - m2) / (sqrt (1 + (cmod m1)2) * sqrt (1 + (cmod m2)2))"
    using power2_eq_iff[of "dist_riemann_sphere' M1 M2" "2 * (cmod (m1 - m2)) / sqrt ((1 + (cmod m1)2) * (1 + (cmod m2)2))"]
    using (1 + (cmod m1)2) * (1 + (cmod m2)2) > 0  (1 + (cmod m1)2) > 0 (1 + (cmod m2)2) > 0
    apply (auto simp add: power2_eq_square real_sqrt_mult[symmetric])
    using dist_riemann_sphere_ge_0[of M1 M2] **
    using ++ divide_le_0_iff by force
qed


lemma dist_stereographic_infinite:
  assumes "stereographic M1 = h" and "stereographic M2 = of_complex m2"
  shows "dist_riemann_sphere' M1 M2 = 2 / sqrt (1 + (cmod m2)2)"
proof-
  have *: "M1 = inv_stereographic h"  "M2 = inv_stereographic (of_complex m2)"
    using inv_stereographic_is_inv assms
    by (metis inv_stereographic_stereographic)+
  have "(1 + (cmod m2)2)  0"
    by (smt power2_less_0)
  have "(1 + (cmod m2)2) > 0"
    by (smt realpow_square_minus_le)+
  hence "sqrt (1 + cmod m2 * cmod m2) > 0"
    using real_sqrt_gt_0_iff
    by (simp add: power2_eq_square)
  hence **: "2 / sqrt (1 + cmod m2 * cmod m2) > 0"
    by simp

  have "(dist_riemann_sphere' M1 M2)2 * (1 + (cmod m2)2) = 4"
    using *
    apply transfer
    apply transfer
  proof-
    fix M1 M2 m2
    assume us: "M1  unit_sphere" "M2  unit_sphere" and
           *: "M1 = inv_stereographic_cvec_r3 v" "M2 = inv_stereographic_cvec_r3 (of_complex_cvec m2)"
    have "(1 + (cmod m2)2)  0"
      by (smt power2_less_0)
    thus "(dist_riemann_sphere_r3 M1 M2)2 * (1 + (cmod m2)2) = 4"
      apply (subst dist_riemann_sphere_r3_inner[OF us])
      apply (subst *)+
      apply (simp add: complex_mult_cnj_cmod)
      apply (subst left_diff_distrib[of 2], simp)
      done
  qed
  hence "(dist_riemann_sphere' M1 M2)2 = 4 / (1 + (cmod m2)2)"
    using (1 + (cmod m2)2)  0
    by (simp add: field_simps)
  thus "dist_riemann_sphere' M1 M2 = 2 / sqrt (1 + (cmod m2)2)"
    using power2_eq_iff[of "dist_riemann_sphere' M1 M2" "2 / sqrt (1 + (cmod m2)2)"]
    using (1 + (cmod m2)2) > 0
    apply (auto simp add: power2_eq_square real_sqrt_mult[symmetric])
    using dist_riemann_sphere_ge_0[of M1 M2] **
    by simp
qed

lemma dist_rieman_sphere_zero [simp]: 
  shows "dist_riemann_sphere' M M = 0"
  by transfer auto

lemma dist_riemann_sphere_sym: 
  shows "dist_riemann_sphere' M1 M2 = dist_riemann_sphere' M2 M1"
proof transfer
  fix M1 M2 :: R3
  obtain x1 y1 z1 x2 y2 z2 where MM: "(x1, y1, z1) = M1" "(x2, y2, z2) = M2"
    by (cases "M1", cases "M2", auto)
  show "dist_riemann_sphere_r3 M1 M2 = dist_riemann_sphere_r3 M2 M1"
    using norm_minus_cancel[of "(x1 - x2, y1 - y2, z1 - z2)"] MM[symmetric]
    by simp
qed

text ‹Central theorem that connects the two metrics.›
lemma dist_stereographic:
  shows "dist_riemann_sphere' M1 M2 = dist_fs (stereographic M1) (stereographic M2)"
proof (cases "M1 = North")
  case True
  hence "stereographic M1 = h"
    by (simp add: stereographic_North)
  show ?thesis
  proof (cases "M2 = North")
    case True
    show ?thesis
      using M1 = North› M2 = North›
      by auto
  next
    case False
    hence "stereographic M2  h"
      using stereographic_North[of M2]
      by simp
    then obtain m2 where "stereographic M2 = of_complex m2"
      using inf_or_of_complex[of "stereographic M2"]
      by auto
    show ?thesis
      using ‹stereographic M2 = of_complex m2 ‹stereographic M1 = h
      using dist_fs_infinite1 dist_stereographic_infinite
      by (simp add: dist_fs_sym)
  qed
next
  case False
  hence "stereographic M1  h"
    by (simp add: stereographic_North)
  then obtain m1 where "stereographic M1 = of_complex m1"
    using inf_or_of_complex[of "stereographic M1"]
    by auto
  show ?thesis
  proof (cases "M2 = North")
    case True
    hence "stereographic M2 = h"
      by (simp add: stereographic_North)
    show ?thesis
      using ‹stereographic M1 = of_complex m1 ‹stereographic M2 = h
      using dist_fs_infinite2 dist_stereographic_infinite
      by (subst dist_riemann_sphere_sym, simp add: dist_fs_sym)
  next
    case False
    hence "stereographic M2  h"
      by (simp add: stereographic_North)
    then obtain m2 where "stereographic M2 = of_complex m2"
      using inf_or_of_complex[of "stereographic M2"]
      by auto
    show ?thesis
      using ‹stereographic M1 = of_complex m1 ‹stereographic M2 = of_complex m2
      using dist_fs_finite dist_stereographic_finite
      by simp
  qed
qed

text ‹Other direction›
lemma dist_stereographic':
  shows "dist_fs A B = dist_riemann_sphere' (inv_stereographic A) (inv_stereographic B)"
  by (subst dist_stereographic) (metis stereographic_inv_stereographic)

text ‹The @{term riemann_sphere} equipped with @{term dist_riemann_sphere'} is a metric space, i.e.,
an instantiation of the @{term metric_space} locale.›

instantiation riemann_sphere :: metric_space
begin
definition "dist_riemann_sphere = dist_riemann_sphere'"
definition "(uniformity_riemann_sphere :: (riemann_sphere × riemann_sphere) filter) = (INF e{0<..}. principal {(x, y). dist_class.dist x y < e})"
definition "open_riemann_sphere (U :: riemann_sphere set) = ( x  U. eventually (λ(x', y). x' = x  y  U) uniformity)"
instance
proof
  fix x y :: riemann_sphere
  show "(dist_class.dist x y = 0) = (x = y)"
    unfolding dist_riemann_sphere_def
  proof transfer
    fix x y :: R3
    obtain x1 y1 z1 x2 y2 z2 where *: "(x1, y1, z1) = x" "(x2, y2, z2) = y"
      by (cases x, cases y, auto)
    assume "x  unit_sphere" "y  unit_sphere"
    thus "(dist_riemann_sphere_r3 x y = 0) = (x = y)"
      using norm_eq_zero[of "(x1 - y2, y1 - y2, z1 - z2)"] using *[symmetric]
      by (simp add: zero_prod_def)
  qed
next
  fix x y z :: riemann_sphere
  show "dist_class.dist x y  dist_class.dist x z + dist_class.dist y z"
    unfolding dist_riemann_sphere_def
  proof transfer
    fix x y z :: R3
    obtain x1 y1 z1 x2 y2 z2 x3 y3 z3 where MM: "(x1, y1, z1) = x" "(x2, y2, z2) = y" "(x3, y3, z3) = z"
      by (cases "x", cases "y", cases "z", auto)

    assume "x  unit_sphere" "y  unit_sphere" "z  unit_sphere"
    thus "dist_riemann_sphere_r3 x y  dist_riemann_sphere_r3 x z + dist_riemann_sphere_r3 y z"
      using MM[symmetric] norm_minus_cancel[of "(x3 - x2, y3 - y2, z3 - z2)"] norm_triangle_ineq[of "(x1 - x3, y1 - y3, z1 - z3)" "(x3 - x2, y3 - y2, z3 - z2)"]
      by simp
  qed
qed (simp_all add: uniformity_riemann_sphere_def open_riemann_sphere_def)
end

text ‹The @{term riemann_sphere} metric space is perfect, i.e., it does not have isolated points.›
instantiation riemann_sphere :: perfect_space
begin
instance proof
  fix M :: riemann_sphere
  show "¬ open {M}"
    unfolding open_dist dist_riemann_sphere_def
    apply (subst dist_riemann_sphere_sym)
  proof transfer
    fix M
    assume "M  unit_sphere"
    obtain x y z where MM: "M = (x, y, z)"
      by (cases "M") auto
    then obtain α β where *: "x = cos α * cos β" "y = cos α * sin β" "z = sin α" "-pi / 2  α  α  pi / 2"
      using M  unit_sphere›
      using ex_sphere_params[of x y z]
      by auto
    have " e. e > 0  (y. y  unit_sphere  dist_riemann_sphere_r3 M y < e  y  M)"
    proof-
      fix e :: real
      assume "e > 0"
      then obtain α' where "1 - (e*e/2) < cos (α - α')" "α  α'" "-pi/2  α'" "α'  pi/2"
        using ex_cos_gt[of α "1 - (e*e/2)"] - pi / 2  α  α  pi / 2
        by auto
      hence "sin α  sin α'"
        using -pi / 2  α  α  pi / 2 sin_inj[of α α']
        by auto

      have "2 - 2 * cos (α - α') < e*e"
        using mult_strict_right_mono[OF 1 - (e*e/2) < cos (α - α'), of 2]
        by (simp add: field_simps)
      have "2 - 2 * cos (α - α')  0"
        using cos_le_one[of "α - α'"]
        by (simp add: algebra_split_simps)
      let ?M' = "(cos α' * cos β,  cos α' * sin β, sin α')"
      have "dist_riemann_sphere_r3 M ?M' = sqrt ((cos α - cos α')2 + (sin α - sin α')2)"
        using MM * sphere_params_on_sphere[of _ α' β]
        using sin_cos_squared_add[of β]
        apply (simp add: dist_riemann_sphere'_def Abs_riemann_sphere_inverse norm_prod_def)
        apply (subst left_diff_distrib[symmetric])+
        apply (subst power_mult_distrib)+
        apply (subst distrib_left[symmetric])
        apply simp
        done
      also have "... = sqrt (2 - 2*cos (α - α'))"
        by (simp add: power2_eq_square field_simps cos_diff)
      finally
      have "(dist_riemann_sphere_r3 M ?M')2 = 2 - 2*cos (α - α')"
        using 2 - 2 * cos (α - α')  0
        by simp
      hence "(dist_riemann_sphere_r3 M ?M')2 < e2"
        using 2 - 2 * cos (α - α') < e*e
        by (simp add: power2_eq_square)
      hence "dist_riemann_sphere_r3 M ?M' < e"
        apply (rule power2_less_imp_less)
        using e > 0
        by simp
      moreover
      have "M  ?M'"
        using MM  ‹sin α  sin α' *
        by simp
      moreover
      have "?M'  unit_sphere"
        using sphere_params_on_sphere by auto
      ultimately
      show "y. y  unit_sphere  dist_riemann_sphere_r3 M y < e  y  M"
        unfolding dist_riemann_sphere_def
        by (rule_tac x="?M'" in exI, simp)
    qed
    thus "¬ (x{M}. e>0. y{x. x  unit_sphere}. dist_riemann_sphere_r3 x y < e  y  {M})"
      by auto
  qed
qed
end

text ‹The @{term complex_homo} metric space is perfect, i.e., it does not have isolated points.›
instantiation complex_homo :: perfect_space
begin
instance proof
  fix x::complex_homo
  show "¬ open {x}"
    unfolding open_dist
  proof (auto)
    fix e::real
    assume "e > 0"
    thus " y. dist_class.dist y x < e  y  x"
      using not_open_singleton[of "inv_stereographic x"]
      unfolding open_dist
      unfolding dist_complex_homo_def dist_riemann_sphere_def
      apply (subst dist_stereographic', auto)
      apply (erule_tac x=e in allE, auto)
      apply (rule_tac x="stereographic y" in exI, auto)
      done
  qed
qed

end

lemma Lim_within:
  shows "(f  l) (at a within S) 
    (e >0. d>0. x  S. 0 < dist_class.dist x a  dist_class.dist x a  < d  dist_class.dist (f x) l < e)"
  by (auto simp: tendsto_iff eventually_at)

lemma continuous_on_iff:
  shows "continuous_on s f 
    (xs. e>0. d>0. x's. dist_class.dist x' x < d  dist_class.dist (f x') (f x) < e)"
  unfolding continuous_on_def Lim_within
  by (metis dist_pos_lt dist_self)

text ‹Using the chordal metric in the extended plane, and the Euclidean metric on the sphere in
$\mathbb{R}^3$, the stereographic and inverse stereographic projections are proved to be
continuous.›

lemma "continuous_on UNIV stereographic"
unfolding continuous_on_iff
unfolding dist_complex_homo_def dist_riemann_sphere_def
by (subst dist_stereographic', auto)

lemma "continuous_on UNIV inv_stereographic"
unfolding continuous_on_iff
unfolding dist_complex_homo_def dist_riemann_sphere_def
by (subst dist_stereographic, auto)

(* -------------------------------------------------------------------------- *)
subsubsection ‹Chordal circles›
(* -------------------------------------------------------------------------- *)

text ‹Real circlines are sets of points that are equidistant from some given point in the chordal
metric. There are exactly two such points (two chordal centers). On the Riemann sphere, these two
points are obtained as intersections of the sphere and a line that goes trough center of the circle,
and its orthogonal to its plane.›

text ‹The circline for the given chordal center and radius.›
definition chordal_circle_cvec_cmat :: "complex_vec  real  complex_mat" where
 [simp]: "chordal_circle_cvec_cmat a r =
           (let (a1, a2) = a
             in ((4*a2*cnj a2 - (cor r)2*(a1*cnj a1 + a2*cnj a2)), (-4*a1*cnj a2), (-4*cnj a1*a2), (4*a1*cnj a1 - (cor r)2*(a1*cnj a1 + a2*cnj a2))))"

lemma chordal_circle_cmat_hermitean_nonzero [simp]:
  assumes "a  vec_zero"
  shows "chordal_circle_cvec_cmat a r  hermitean_nonzero"
  using assms
  by (cases a) (auto simp add: hermitean_def mat_adj_def mat_cnj_def Let_def)

lift_definition chordal_circle_hcoords_clmat :: "complex_homo_coords  real  circline_mat" is chordal_circle_cvec_cmat
  using chordal_circle_cmat_hermitean_nonzero
  by (simp del: chordal_circle_cvec_cmat_def)

lift_definition chordal_circle :: "complex_homo  real  circline" is chordal_circle_hcoords_clmat
proof transfer
  fix a b :: complex_vec and r :: real
  assume *: "a  vec_zero" "b  vec_zero"
  obtain a1 a2 where aa: "a = (a1, a2)"
    by (cases a, auto)
  obtain b1 b2 where bb: "b = (b1, b2)"
    by (cases b, auto)
  assume "a v b"
  then obtain k where "b = (k * a1, k * a2)" "k  0"
    using aa bb
    by auto
  moreover
  have "cor (Re (k * cnj k)) = k * cnj k"
    by (metis complex_In_mult_cnj_zero complex_of_real_Re)
  ultimately
  show "circline_eq_cmat (chordal_circle_cvec_cmat a r) (chordal_circle_cvec_cmat b r)"
    using * aa bb
    by simp (rule_tac x="Re (k*cnj k)" in exI, auto simp add: Let_def field_simps)
qed

lemma sqrt_1_plus_square:
  shows "sqrt (1 + a2)  0"
  by (smt real_sqrt_less_mono real_sqrt_zero realpow_square_minus_le)

lemma
  assumes "dist_fs z a = r"
  shows "z  circline_set (chordal_circle a r)"
proof (cases "a  h")
  case True
  then obtain a' where  "a = of_complex a'"
    using inf_or_of_complex
    by auto
  let ?A = "4 - (cor r)2 * (1 + (a'*cnj a'))" and ?B = "-4*a'" and ?C="-4*cnj a'" and ?D = "4*a'*cnj a' -  (cor r)2 * (1 + (a'*cnj a'))"
  have hh: "(?A, ?B, ?C, ?D)  {H. hermitean H  H  mat_zero}"
    by (auto simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square)
  hence *: "chordal_circle (of_complex a') r = mk_circline ?A ?B ?C ?D"
    by (transfer, transfer, simp, rule_tac x=1 in exI, simp)

  show ?thesis
  proof (cases "z  h")
    case True
    then obtain z' where "z = of_complex z'"
      using inf_or_of_complex[of z] inf_or_of_complex[of a]
      by auto
    have "2 * cmod (z' - a') / (sqrt (1 + (cmod z')2) * sqrt (1 + (cmod a')2)) = r"
      using dist_fs_finite[of z' a'] assms z = of_complex z' a = of_complex a'
      by auto
    hence "4 * (cmod (z' - a'))2 / ((1 + (cmod z')2) * (1 + (cmod a')2)) = r2 "
      by (auto simp add: field_simps)
    moreover
    have "sqrt (1 + (cmod z')2)  0" "sqrt (1 + (cmod a')2)  0"
      using sqrt_1_plus_square
      by simp+
    hence "(1 + (cmod z')2) * (1 + (cmod a')2)  0"
      by simp
    ultimately
    have "4 * (cmod (z' - a'))2  = r2 * ((1 + (cmod z')2) * (1 + (cmod a')2))"
      by (simp add: field_simps)
    hence "4 * Re ((z' - a')*cnj (z' - a')) = r2 * (1 + Re (z'*cnj z')) * (1 + Re (a'*cnj a'))"
      by ((subst cmod_square[symmetric])+, simp)
    hence "4 * (Re(z'*cnj z') - Re(a'*cnj z') - Re(cnj a'*z') + Re(a'*cnj a')) = r2 * (1 + Re (z'*cnj z')) * (1 + Re (a'*cnj a'))"
      by (simp add: field_simps)
    hence "Re (?A * z' * cnj z' + ?B * cnj z' + ?C * z' + ?D) = 0"
      by (simp add: power2_eq_square field_simps)
    hence "?A * z' * cnj z' + ?B * cnj z' + ?C * z' + ?D = 0"
      by (subst complex_eq_if_Re_eq) (auto simp add: power2_eq_square)
    hence "(cnj z' * ?A + ?C) * z' + (cnj z' * ?B + ?D) = 0"
      by algebra
    hence "z  circline_set (mk_circline ?A ?B ?C ?D)"
      using z = of_complex z' hh
      unfolding circline_set_def
      by simp (transfer, transfer, simp add: vec_cnj_def)
    thus ?thesis
      using *
      by (subst a = of_complex a') simp
  next
    case False
    hence "2 / sqrt (1 + (cmod a')2) = r"
      using assms a = of_complex a'
      using dist_fs_infinite2[of a']
      by simp
    moreover
    have "sqrt (1 + (cmod a')2)  0"
      using sqrt_1_plus_square
      by simp
    ultimately
    have "2 = r * sqrt (1 + (cmod a')2)"
      by (simp add: field_simps)
    hence "4 = (r * sqrt (1 + (cmod a')2))2"
      by simp
    hence "4 = r2 * (1 + (cmod a')2)"
      by (simp add: power_mult_distrib)
    hence "Re (4 - (cor r)2 * (1 + (a' * cnj a'))) = 0"
      by (subst (asm) cmod_square) (simp add: field_simps power2_eq_square)
    hence "4 - (cor r)2 * (1 + (a'*cnj a')) = 0"
      by (subst complex_eq_if_Re_eq) (auto simp add: power2_eq_square)
    hence "circline_A0 (mk_circline ?A ?B ?C ?D)"
      using hh
      by (simp, transfer, transfer, simp)
    hence "z  circline_set (mk_circline ?A ?B ?C ?D)"
      using inf_in_circline_set[of "mk_circline ?A ?B ?C ?D"]
      using ¬ z  h
      by simp
    thus ?thesis
      using *
      by (subst a = of_complex a') simp
  qed
next
  case False
  let ?A = "-(cor r)2" and ?B = "0" and ?C = "0" and ?D = "4 -(cor r)2"
  have hh: "(?A, ?B, ?C, ?D)  {H. hermitean H  H  mat_zero}"
    by (auto simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square)
  hence *: "chordal_circle a r = mk_circline ?A ?B ?C ?D"
    using ¬ a  h
    by simp (transfer, transfer, simp, rule_tac x=1 in exI, simp)

  show ?thesis
  proof (cases "z = h")
    case True
    show ?thesis
      using assms z = h ¬ a  h
      using * hh
      by (simp, subst inf_in_circline_set, transfer, transfer, simp)
  next
    case False
    then obtain z' where "z = of_complex z'"
      using inf_or_of_complex[of z]
      by auto
    have "2 / sqrt (1 + (cmod z')2) = r"
      using assms z = of_complex z'¬ a  h
      using dist_fs_infinite2[of z']
      by (simp add: dist_fs_sym)
    moreover
    have "sqrt (1 + (cmod z')2)  0"
      using sqrt_1_plus_square
      by simp
    ultimately
    have "2 = r * sqrt (1 + (cmod z')2)"
      by (simp add: field_simps)
    hence "4 = (r * sqrt (1 + (cmod z')2))2"
      by simp
    hence "4 = r2 * (1 + (cmod z')2)"
      by (simp add: power_mult_distrib)
    hence "Re (4 - (cor r)2 * (1 + (z' * cnj z'))) = 0"
      by (subst (asm) cmod_square) (simp add: field_simps power2_eq_square)
    hence "- (cor r)2 * z'*cnj z' + 4 - (cor r)2 = 0"
      by (subst complex_eq_if_Re_eq) (auto simp add: power2_eq_square field_simps)
    hence "z  circline_set (mk_circline ?A ?B ?C ?D)"
      using hh
      unfolding circline_set_def
      by (subst z = of_complex z', simp) (transfer, transfer, auto simp add: vec_cnj_def field_simps)
    thus ?thesis
      using *
      by simp
  qed
qed

lemma
  assumes "z  circline_set (chordal_circle a r)" and "r  0"
  shows "dist_fs z a = r"
proof (cases "a = h")
  case False
  then obtain a' where "a = of_complex a'"
    using inf_or_of_complex
    by auto

  let ?A = "4 - (cor r)2 * (1 + (a'*cnj a'))" and ?B = "-4*a'" and ?C="-4*cnj a'" and ?D = "4*a'*cnj a' -  (cor r)2 * (1 + (a'*cnj a'))"
  have hh: "(?A, ?B, ?C, ?D)  {H. hermitean H  H  mat_zero}"
    by (auto simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square)
  hence *: "chordal_circle (of_complex a') r = mk_circline ?A ?B ?C ?D"
    by (transfer, transfer, simp, rule_tac x=1 in exI, simp)

  show ?thesis
  proof (cases "z = h")
    case False
    then obtain z' where "z = of_complex z'"
      using inf_or_of_complex[of z] inf_or_of_complex[of a]
      by auto
    hence "z  circline_set (mk_circline ?A ?B ?C ?D)"
      using assms a = of_complex a' *
      by simp
    hence "(cnj z' * ?A + ?C) * z' + (cnj z' * ?B + ?D) = 0"
      using hh
      unfolding circline_set_def
      by (subst (asm) z = of_complex z', simp) (transfer, transfer, simp add: vec_cnj_def)
    hence "?A * z' * cnj z' + ?B * cnj z' + ?C * z' + ?D = 0"
      by algebra
    hence "Re (?A * z' * cnj z' + ?B * cnj z' +?C * z' +?D) = 0"
      by (simp add: power2_eq_square field_simps)
    hence "4 * Re ((z' - a')*cnj (z' - a')) = r2 * (1 + Re (z'*cnj z')) * (1 + Re (a'*cnj a'))"
      by (simp add: field_simps power2_eq_square)
    hence "4 * (cmod (z' - a'))2  = r2 * ((1 + (cmod z')2) * (1 + (cmod a')2))"
      by (subst cmod_square)+ simp
    moreover
    have "sqrt (1 + (cmod z')2)  0" "sqrt (1 + (cmod a')2)  0"
      using sqrt_1_plus_square
      by simp+
    hence "(1 + (cmod z')2) * (1 + (cmod a')2)  0"
      by simp
    ultimately
    have "4 * (cmod (z' - a'))2 / ((1 + (cmod z')2) * (1 + (cmod a')2)) = r2 "
      by (simp add: field_simps)
    hence "2 * cmod (z' - a') / (sqrt (1 + (cmod z')2) * sqrt (1 + (cmod a')2)) = r"
      using r  0
      by (subst (asm) real_sqrt_eq_iff[symmetric]) (simp add: real_sqrt_mult real_sqrt_divide)
    thus ?thesis
      using z = of_complex z' a = of_complex a'
      using dist_fs_finite[of z' a']
      by simp
  next
    case True
    have "z  circline_set (mk_circline ?A ?B ?C ?D)"
      using assms a = of_complex a' *
      by simp
    hence "circline_A0 (mk_circline ?A ?B ?C ?D)"
      using inf_in_circline_set[of "mk_circline ?A ?B ?C ?D"]
      using z = h
      by simp
    hence "4 - (cor r)2 * (1 + (a'*cnj a')) = 0"
      using hh
      by (transfer, transfer, simp)
    hence "Re (4 - (cor r)2 * (1 + (a' * cnj a'))) = 0"
      by simp
    hence "4 = r2 * (1 + (cmod a')2)"
      by (subst cmod_square) (simp add: power2_eq_square)
    hence "2 = r * sqrt (1 + (cmod a')2)"
      using r  0
      by (subst (asm) real_sqrt_eq_iff[symmetric]) (simp add: real_sqrt_mult)
    moreover
    have "sqrt (1 + (cmod a')2)  0"
      using sqrt_1_plus_square
      by simp
    ultimately
    have "2 / sqrt (1 + (cmod a')2) = r"
      by (simp add: field_simps)
    thus ?thesis
      using a = of_complex a' z = h
      using dist_fs_infinite2[of a']
      by simp
  qed
next
  case True
  let ?A = "-(cor r)2" and ?B = "0" and ?C = "0" and ?D = "4 -(cor r)2"
  have hh: "(?A, ?B, ?C, ?D)  {H. hermitean H  H  mat_zero}"
    by (auto simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square)
  hence *: "chordal_circle a r = mk_circline ?A ?B ?C ?D"
    using a = h
    by simp (transfer, transfer, simp, rule_tac x=1 in exI, simp)

  show ?thesis
  proof (cases "z = h")
    case True
    thus ?thesis
      using a = h assms * hh
      by simp (subst (asm) inf_in_circline_set, transfer, transfer, simp)
  next
    case False
    then obtain z' where "z = of_complex z'"
      using inf_or_of_complex
      by auto
    hence "z  circline_set (mk_circline ?A ?B ?C ?D)"
      using assms *
      by simp
    hence "- (cor r)2 * z'*cnj z' + 4 - (cor r)2 = 0"
      using hh
      unfolding circline_set_def
      apply (subst (asm) z = of_complex z')
      by (simp, transfer, transfer, simp add: vec_cnj_def, algebra)
    hence "4 - (cor r)2 * (1 + (z'*cnj z')) = 0"
      by (simp add: field_simps)
    hence "Re (4 - (cor r)2 * (1 + (z' * cnj z'))) = 0"
      by simp
    hence "4 = r2 * (1 + (cmod z')2)"
      by (subst cmod_square) (simp add: power2_eq_square)
    hence "2 = r * sqrt (1 + (cmod z')2)"
      using r  0
      by (subst (asm) real_sqrt_eq_iff[symmetric]) (simp add: real_sqrt_mult)
    moreover
    have "sqrt (1 + (cmod z')2)  0"
      using sqrt_1_plus_square
      by simp
    ultimately
    have "2 / sqrt (1 + (cmod z')2) = r"
      by (simp add: field_simps)
    thus ?thesis
      using z = of_complex z' a = h
      using dist_fs_infinite2[of z']
      by (simp add: dist_fs_sym)
  qed
qed

text ‹Two chordal centers and radii for the given circline›
definition chordal_circles_cmat :: "complex_mat  (complex × real) × (complex × real)"  where
 [simp]: "chordal_circles_cmat H =
     (let (A, B, C, D) = H;
          dsc = sqrt(Re ((D-A)2 + 4 * (B*cnj B)));
          a1 = (A - D + cor dsc) / (2 * C);
          r1 = sqrt((4 - Re((-4 * a1/B) * A)) / (1 + Re (a1*cnj a1)));
          a2 = (A - D - cor dsc) / (2 * C);
          r2 = sqrt((4 - Re((-4 * a2/B) * A)) / (1 + Re (a2*cnj a2)))
       in ((a1, r1), (a2, r2)))"

lift_definition chordal_circles_clmat :: "circline_mat  (complex × real) × (complex × real)" is chordal_circles_cmat
  done

lift_definition chordal_circles :: "ocircline  (complex × real) × (complex × real)" is chordal_circles_clmat
proof transfer
  fix H1 H2 :: complex_mat
  obtain A1 B1 C1 D1 where hh1: "(A1, B1, C1, D1) = H1"
    by (cases H1) auto
  obtain A2 B2 C2 D2 where hh2: "(A2, B2, C2, D2) = H2"
    by (cases H2) auto

  assume "ocircline_eq_cmat H1 H2"
  then obtain k where *: "k > 0" "A2 = cor k * A1" "B2 = cor k * B1" "C2 = cor k * C1" "D2 = cor k * D1"
    using hh1[symmetric] hh2[symmetric]
    by auto
  let ?dsc1 = "sqrt (Re ((D1 - A1)2 + 4 * (B1 * cnj B1)))" and ?dsc2 = "sqrt (Re ((D2 - A2)2 + 4 * (B2 * cnj B2)))"
  let ?a11 = "(A1 - D1 + cor ?dsc1) / (2 * C1)" and ?a12 = "(A2 - D2 + cor ?dsc2) / (2 * C2)"
  let ?a21 = "(A1 - D1 - cor ?dsc1) / (2 * C1)" and ?a22 = "(A2 - D2 - cor ?dsc2) / (2 * C2)"
  let ?r11 = "sqrt((4 - Re((-4 * ?a11/B1) * A1)) / (1 + Re (?a11*cnj ?a11)))"
  let ?r12 = "sqrt((4 - Re((-4 * ?a12/B2) * A2)) / (1 + Re (?a12*cnj ?a12)))"
  let ?r21 = "sqrt((4 - Re((-4 * ?a21/B1) * A1)) / (1 + Re (?a21*cnj ?a21)))"
  let ?r22 = "sqrt((4 - Re((-4 * ?a22/B2) * A2)) / (1 + Re (?a22*cnj ?a22)))"

  have "Re ((D2 - A2)2 + 4 * (B2 * cnj B2)) = k2 * Re ((D1 - A1)2 + 4 * (B1 * cnj B1))"
    using *
    by (simp add: power2_eq_square field_simps)
  hence "?dsc2 = k * ?dsc1"
    using k > 0
    by (simp add: real_sqrt_mult)
  hence "A2 - D2 + cor ?dsc2 = cor k * (A1 - D1 + cor ?dsc1)" "A2 - D2 - cor ?dsc2 = cor k * (A1 - D1 - cor ?dsc1)" "2*C2 = cor k * (2*C1)"
    using *
    by (auto simp add: field_simps)
  hence "?a12 = ?a11" "?a22 = ?a21"
    using k > 0
    by simp_all
  moreover
  have "Re((-4 * ?a12/B2) * A2) = Re((-4 * ?a11/B1) * A1)"
    using *
    by (subst ?a12 = ?a11) (simp, simp add: field_simps)
  have "?r12 = ?r11"
    by (subst ‹Re((-4 * ?a12/B2) * A2) = Re((-4 * ?a11/B1) * A1), (subst ?a12 = ?a11)+) simp
  moreover
  have "Re((-4 * ?a22/B2) * A2) = Re((-4 * ?a21/B1) * A1)"
    using *
    by (subst ?a22 = ?a21) (simp, simp add: field_simps)
  have "?r22 = ?r21"
    by (subst ‹Re((-4 * ?a22/B2) * A2) = Re((-4 * ?a21/B1) * A1), (subst ?a22 = ?a21)+) simp
  moreover
  have "chordal_circles_cmat H1 = ((?a11, ?r11), (?a21, ?r21))"
    using hh1[symmetric]
    unfolding chordal_circles_cmat_def Let_def
    by (simp del: times_complex.sel)
  moreover
  have "chordal_circles_cmat H2 = ((?a12, ?r12), (?a22, ?r22))"
    using hh2[symmetric]
    unfolding chordal_circles_cmat_def Let_def
    by (simp del: times_complex.sel)
  ultimately
  show "chordal_circles_cmat H1 = chordal_circles_cmat H2"
    by metis
qed

lemma chordal_circle_radius_positive:
  assumes "hermitean (A, B, C, D)" and "Re (mat_det (A, B, C, D))  0" and "B  0" and
  "dsc = sqrt(Re ((D-A)2 + 4 * (B*cnj B)))" and 
  "a1 = (A - D + cor dsc) / (2 * C)" and "a2 = (A - D - cor dsc) / (2 * C)"
  shows "Re (A*a1/B)  -1  Re (A*a2/B)  -1"
proof-
  from assms have "is_real A" "is_real D" "C = cnj B"
    using hermitean_elems
    by auto
  have *: "A*a1/B = ((A - D + cor dsc) / (2 * (B * cnj B))) * A"
    using B  0 C = cnj B a1 = (A - D + cor dsc) / (2 * C)
    by (simp add: field_simps) algebra
  have **: "A*a2/B = ((A - D - cor dsc) / (2 * (B * cnj B))) * A"
    using B  0 C = cnj B a2 = (A - D - cor dsc) / (2 * C)
    by (simp add: field_simps) algebra
  have "dsc  0"
  proof-
    have "0  Re ((D - A)2) + 4 * Re ((cor (cmod B))2)"
      using ‹is_real A ‹is_real D by simp
    thus ?thesis
      using dsc = sqrt(Re ((D-A)2 + 4*(B*cnj B)))
      by (subst (asm) complex_mult_cnj_cmod) simp
  qed
  hence "Re (A - D - cor dsc)  Re (A - D + cor dsc)"
    by simp
  moreover
  have "Re (2 * (B * cnj B)) > 0"
    using B  0
    by (subst complex_mult_cnj_cmod, simp add: power2_eq_square)
  ultimately
  have xxx: "Re (A - D + cor dsc) / Re (2 * (B * cnj B))  Re (A - D - cor dsc) / Re (2 * (B * cnj B))" (is "?lhs  ?rhs")
    by (metis divide_right_mono less_eq_real_def)

  have "Re A * Re D  Re (B*cnj B)"
    using ‹Re (mat_det (A, B, C, D))  0 C = cnj B ‹is_real A ‹is_real D
    by simp


  have "(Re (2 * (B * cnj B)) / Re A) / Re (2 * B * cnj B) = 1 / Re A"
    using ‹Re (2 * (B * cnj B)) > 0
    apply (subst divide_divide_eq_left)
    apply (subst mult.assoc)
    apply (subst nonzero_divide_mult_cancel_right)
    by simp_all

  show ?thesis
  proof (cases "Re A > 0")
    case True
    hence "Re (A*a1/B)  Re (A*a2/B)"
      using * ** ‹Re (2 * (B * cnj B)) > 0 B  0 ‹is_real A ‹is_real D xxx
      using mult_right_mono[of ?rhs ?lhs "Re A"]
      apply simp
      apply (subst Re_divide_real, simp, simp)
      apply (subst Re_divide_real, simp, simp)
      apply (subst Re_mult_real, simp)+
      apply simp
      done
    moreover
    have "Re (A*a2/B)  -1"
    proof-
      from ‹Re A * Re D  Re (B*cnj B)
      have "Re (A2)  Re (B*cnj B) + Re ((A - D)*A)"
        using ‹Re A > 0 ‹is_real A ‹is_real D
        by (simp add: power2_eq_square field_simps)
      have "1  Re (B*cnj B) / Re (A2) + Re (A - D) / Re A"
        using ‹Re A > 0 ‹is_real A ‹is_real D
        using divide_right_mono[OF ‹Re (A2)  Re (B*cnj B) + Re ((A - D)*A), of "Re (A2)"]
        by (simp add: power2_eq_square add_divide_distrib)
      have "4 * Re(B*cnj B)  4 * (Re (B*cnj B))2 / Re (A2)  + 2*Re (A - D) / Re A * 2 * Re(B*cnj B)"
        using mult_right_mono[OF 1  Re (B*cnj B) / Re (A2) + Re (A - D) / Re A, of "4 * Re (B*cnj B)"]
        by (simp add: distrib_right) (simp add: power2_eq_square field_simps)
      moreover
      have "A  0"
        using ‹Re A > 0
        by auto
      hence "4 * (Re (B*cnj B))2 / Re (A2) = Re (4 * (B*cnj B)2 / A2)"
        using Re_divide_real[of "A2" "4 * (B*cnj B)2"] ‹Re A > 0 ‹is_real A
        by (auto simp add: power2_eq_square)
      moreover
      have "2*Re (A - D) / Re A * 2 * Re(B*cnj B) = Re (2 * (A - D) / A * 2 * B * cnj B)"
        using ‹is_real A ‹is_real D A  0
        using Re_divide_real[of "A" "(4 * A - 4 * D) * B * cnj B"]
        by (simp add: field_simps)
      ultimately
      have "Re ((D - A)2 + 4 * B*cnj B)  Re((A - D)2 + 4 * (B*cnj B)2 / A2  + 2*(A - D) / A * 2 * B*cnj B)"
        by (simp add: field_simps power2_eq_square)
      hence "Re ((D - A)2 + 4 * B*cnj B)  Re(((A - D) +  2 * B*cnj B / A)2)"
        using A  0
        by (subst power2_sum) (simp add: power2_eq_square field_simps)
      hence "dsc  sqrt (Re(((A - D) +  2 * B*cnj B / A)2))"
        using dsc = sqrt(Re ((D-A)2 + 4*(B*cnj B)))
        by simp
      moreover
      have "Re(((A - D) +  2 * B*cnj B / A)2) = (Re((A - D) +  2 * B*cnj B / A))2"
        using ‹is_real A ‹is_real D div_reals
        by (simp add: power2_eq_square)
      ultimately
      have "dsc  ¦Re (A - D + 2 * B * cnj B / A)¦"
        by simp
      moreover
      have "Re (A - D + 2 * B * cnj B / A)  0"
      proof-
        have *: "Re (A2 + B*cnj B)  0"
          using ‹is_real A
          by (simp add: power2_eq_square)
        also have "Re (A2 + 2*B*cnj B - A*D)  Re (A2 + B*cnj B)"
          using ‹Re A * Re D  Re (B*cnj B)
          using ‹is_real A ‹is_real D
          by simp
        finally
        have "Re (A2 + 2*B*cnj B - A*D)  0"
          by simp
        show ?thesis
          using divide_right_mono[OF ‹Re (A2 + 2*B*cnj B - A*D)  0, of "Re A"] ‹Re A > 0 ‹is_real A A  0
          by (simp add: add_divide_distrib diff_divide_distrib) (subst Re_divide_real, auto simp add: power2_eq_square field_simps)
      qed
      ultimately
      have "dsc  Re (A - D + 2 * B * cnj B / A)"
        by simp
      hence "- Re (2 * (B * cnj B) / A)  Re ((A - D - cor dsc))"
        by (simp add: field_simps)
      hence *: "- (Re (2 * (B * cnj B)) / Re A)  Re (A - D - cor dsc)"
        using ‹is_real A A  0
        by (subst (asm) Re_divide_real, auto)
      from divide_right_mono[OF this, of "Re (2 * B * cnj B)"]
      have "- 1 / Re A  Re (A - D - cor dsc) / Re (2 * B * cnj B)"
        using ‹Re A > 0 B  0 A  0 0 < Re (2 * (B * cnj B))
        using (Re (2 * (B * cnj B)) / Re A) / Re (2 * B * cnj B) = 1 / Re A
        by simp
      from mult_right_mono[OF this, of "Re A"]
      show ?thesis
        using ‹is_real A ‹is_real D B  0 ‹Re A > 0 A  0
        apply (subst **)
        apply (subst Re_mult_real, simp)
        apply (subst Re_divide_real, simp, simp)
        apply (simp add: field_simps)
        done
    qed
    ultimately
    show ?thesis
      by simp
  next
    case False
    show ?thesis
    proof (cases "Re A < 0")
      case True
      hence "Re (A*a1/B)  Re (A*a2/B)"
        using * ** ‹Re (2 * (B * cnj B)) > 0 B  0 ‹is_real A ‹is_real D xxx
        using mult_right_mono_neg[of ?rhs ?lhs "Re A"]
        apply simp
        apply (subst Re_divide_real, simp, simp)
        apply (subst Re_divide_real, simp, simp)
        apply (subst Re_mult_real, simp)+
        apply simp
        done
      moreover
      have "Re (A*a1/B)  -1"
      proof-
        from ‹Re A * Re D  Re (B*cnj B)
        have "Re (A2)  Re (B*cnj B) - Re ((D - A)*A)"
          using ‹Re A < 0 ‹is_real A ‹is_real D
          by (simp add: power2_eq_square field_simps)
        hence "1  Re (B*cnj B) / Re (A2) - Re (D - A) / Re A"
          using ‹Re A < 0 ‹is_real A ‹is_real D
          using divide_right_mono[OF ‹Re (A2)  Re (B*cnj B) - Re ((D - A)*A), of "Re (A2)"]
          by (simp add: power2_eq_square diff_divide_distrib)
        have "4 * Re(B*cnj B)  4 * (Re (B*cnj B))2 / Re (A2)  - 2*Re (D - A) / Re A * 2 * Re(B*cnj B)"
          using mult_right_mono[OF 1  Re (B*cnj B) / Re (A2) - Re (D - A) / Re A, of "4 * Re (B*cnj B)"]
          by (simp add: left_diff_distrib) (simp add: power2_eq_square field_simps)
        moreover
        have "A  0"
          using ‹Re A < 0
          by auto
        hence "4 * (Re (B*cnj B))2 / Re (A2) = Re (4 * (B*cnj B)2 / A2)"
          using Re_divide_real[of "A2" "4 * (B*cnj B)2"] ‹Re A < 0 ‹is_real A
          by (auto simp add: power2_eq_square)
        moreover
        have "2*Re (D - A) / Re A * 2 * Re(B*cnj B) = Re (2 * (D - A) / A * 2 * B * cnj B)"
          using ‹is_real A ‹is_real D A  0
          using Re_divide_real[of "A" "(4 * D - 4 * A) * B * cnj B"]
          by (simp add: field_simps)
        ultimately
        have "Re ((D - A)2 + 4 * B*cnj B)  Re((D - A)2 + 4 * (B*cnj B)2 / A2  - 2*(D - A) / A * 2 * B*cnj B)"
          by (simp add: field_simps power2_eq_square)
        hence "Re ((D - A)2 + 4 * B*cnj B)  Re(((D - A) -  2 * B*cnj B / A)2)"
          using A  0
          by (subst power2_diff) (simp add: power2_eq_square field_simps)
        hence "dsc  sqrt (Re(((D - A) -  2 * B*cnj B / A)2))"
          using dsc = sqrt(Re ((D-A)2 + 4*(B*cnj B)))
          by simp
        moreover
        have "Re(((D - A) -  2 * B*cnj B / A)2) = (Re((D - A) -  2 * B*cnj B / A))2"
          using ‹is_real A ‹is_real D div_reals
          by (simp add: power2_eq_square)
        ultimately
        have "dsc  ¦Re (D - A - 2 * B * cnj B / A)¦"
          by simp
        moreover
        have "Re (D - A - 2 * B * cnj B / A)  0"
        proof-
          have "Re (A2 + B*cnj B)  0"
            using ‹is_real A
            by (simp add: power2_eq_square)
          also have "Re (A2 + 2*B*cnj B - A*D)  Re (A2 + B*cnj B)"
            using ‹Re A * Re D  Re (B*cnj B)
            using ‹is_real A ‹is_real D
            by simp
          finally have "Re (A2 + 2*B*cnj B - A*D)  0"
            by simp
          show ?thesis
            using divide_right_mono_neg[OF ‹Re (A2 + 2*B*cnj B - A*D)  0, of "Re A"] ‹Re A < 0 ‹is_real A A  0
            by (simp add: add_divide_distrib diff_divide_distrib) (subst Re_divide_real, auto simp add: power2_eq_square field_simps)
        qed
        ultimately
        have "dsc  Re (D - A - 2 * B * cnj B / A)"
          by simp
        hence "- Re (2 * (B * cnj B) / A)  Re ((A - D + cor dsc))"
          by (simp add: field_simps)
        hence "- (Re (2 * (B * cnj B)) / Re A)  Re (A - D + cor dsc)"
          using ‹is_real A A  0
          by (subst (asm) Re_divide_real, auto)
        from divide_right_mono[OF this, of "Re (2 * B * cnj B)"]
        have "- 1 / Re A  Re (A - D + cor dsc) / Re (2 * B * cnj B)"
          using ‹Re A < 0 B  0 A  0 0 < Re (2 * (B * cnj B))
          using (Re (2 * (B * cnj B)) / Re A) / Re (2 * B * cnj B) = 1 / Re A
          by simp
        from mult_right_mono_neg[OF this, of "Re A"]
        show ?thesis
          using ‹is_real A ‹is_real D B  0 ‹Re A < 0 A  0
          apply (subst *)
          apply (subst Re_mult_real, simp)
          apply (subst Re_divide_real, simp, simp)
          apply (simp add: field_simps)
          done
      qed
      ultimately
      show ?thesis
        by simp
    next
      case False
      hence "A = 0"
        using ¬ Re A > 0 ‹is_real A
        using complex_eq_if_Re_eq by auto
      thus ?thesis
        by simp
    qed
  qed
qed


lemma chordal_circle_det_positive:
  fixes x y :: real
  assumes "x * y < 0"
  shows "x / (x - y) > 0"
proof (cases "x > 0")
  case True
  hence "y < 0"
    using x * y < 0
    by (smt mult_nonneg_nonneg)
  have "x - y > 0"
    using x > 0 y < 0
    by auto
  thus ?thesis
    using x > 0
    by (metis zero_less_divide_iff)
next
  case False
  hence *: "y > 0  x < 0"
    using x * y < 0
    using mult_nonpos_nonpos[of x y]
    by (cases "x=0") force+

  have "x - y < 0"
    using *
    by auto
  thus ?thesis
    using *
    by (metis zero_less_divide_iff)
qed

lemma cor_sqrt_squared: "x  0  (cor (sqrt x))2 = cor x"
  by (simp add: power2_eq_square)

lemma chordal_circle1:
  assumes "is_real A" and "is_real D" and "Re (A * D) < 0" and "r = sqrt(Re ((4*A)/(A-D)))"
  shows "mk_circline A 0 0 D = chordal_circle h r"
using assms
proof (transfer, transfer)
  fix A D r
  assume *: "is_real A" "is_real D" "Re (A * D) < 0" "r = sqrt (Re ((4*A)/(A-D)))"
  hence "A  0  D  0"
    by auto
  hence "(A, 0, 0, D)  hermitean_nonzero"
    using eq_cnj_iff_real[of A] eq_cnj_iff_real[of D] *
    unfolding hermitean_def
    by (simp add: mat_adj_def mat_cnj_def)
  moreover
  have "(- (cor r)2, 0, 0, 4 - (cor r)2)  hermitean_nonzero"
    by (simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square)
  moreover
  have "A  D"
    using ‹Re (A * D) < 0 ‹is_real A ‹is_real D
    by auto
  have "Re ((4*A)/(A-D))  0"
  proof-
    have "Re A / Re (A - D)  0"
      using ‹Re (A * D) < 0 ‹is_real A ‹is_real D
      using chordal_circle_det_positive[of "Re A" "Re D"]
      by simp
    thus ?thesis
      using ‹is_real A ‹is_real D A  D
      by (subst Re_divide_real, auto)
  qed
  moreover
  have "- (cor (sqrt (Re (4 * A / (A - D)))))2 = cor (Re (4 / (D - A))) * A"
    using ‹is_real A ‹is_real D A  D ‹Re ((4*A)/(A-D))  0
    by (simp add: cor_sqrt_squared field_simps)
  moreover
  have "4 - 4 * A / (A - D) = 4 * D / (D - A)"
    usingA  D 
    by (simp add: divide_simps split: if_split_asm) (simp add: minus_mult_right)
  hence **: "4 - (cor (sqrt (Re (4 * A / (A - D)))))2 = cor (Re (4 / (D - A))) * D"
    using ‹Re ((4*A)/(A-D))  0 ‹is_real A ‹is_real D A  D
    by (simp add: cor_sqrt_squared field_simps)
  ultimately
  show "circline_eq_cmat (mk_circline_cmat A 0 0 D) (chordal_circle_cvec_cmat v r)"
    using * ‹is_real A ‹is_real D A  D r = sqrt(Re ((4*A)/(A-D)))
    by (simp, rule_tac x="Re(4/(D-A))" in exI, auto, simp_all add: **)
qed

lemma chordal_circle2:
  assumes "is_real A" and "is_real D" and "Re (A * D) < 0" and "r = sqrt(Re ((4*D)/(D-A)))"
  shows "mk_circline A 0 0 D = chordal_circle 0h r"
using assms
proof (transfer, transfer)
  fix A D r
  assume *: "is_real A" "is_real D" "Re (A * D) < 0" "r = sqrt (Re ((4*D)/(D-A)))"
  hence "A  0  D  0"
    by auto
  hence "(A, 0, 0, D)  {H. hermitean H  H  mat_zero}"
    using eq_cnj_iff_real[of A] eq_cnj_iff_real[of D] *
    unfolding hermitean_def
    by (simp add: mat_adj_def mat_cnj_def)
  moreover
  have "(4 - (cor r)2, 0, 0, - (cor r)2)  {H. hermitean H  H  mat_zero}"
    by (auto simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square)
  moreover
  have "A  D"
    using ‹Re (A * D) < 0 ‹is_real A ‹is_real D
    by auto
  have "Re((4*D)/(D-A))  0"
  proof-
    have "Re D / Re (D - A)  0"
      using ‹Re (A * D) < 0 ‹is_real A ‹is_real D
      using chordal_circle_det_positive[of "Re D" "Re A"]
      by (simp add: field_simps)
    thus ?thesis
      using ‹is_real A ‹is_real D A  D Re_divide_real by force
  qed
  have  "4 - 4 * D / (D - A) = 4 * A / (A - D)"
    by (simp add: divide_simps split: if_split_asm) (simp add: A  D minus_mult_right)
  hence **: "4 - (cor (sqrt (Re ((4*D)/(D-A)))))2 = cor (Re (4 / (A - D))) * A"
    using ‹is_real A ‹is_real D A  D ‹Re (4 * D / (D - A))  0
    by (simp add: cor_sqrt_squared field_simps)
  moreover
  have "- (cor (sqrt (Re ((4*D)/(D-A)))))2 = cor (Re (4 / (A - D))) * D"
    using ‹is_real A ‹is_real D A  D ‹Re (4 * D / (D - A))  0
    by (simp add: cor_sqrt_squared field_simps)
  ultimately
  show "circline_eq_cmat (mk_circline_cmat A 0 0 D) (chordal_circle_cvec_cmat 0v r)"
    using ‹is_real A ‹is_real D A  0  D  0 r = sqrt (Re ((4*D)/(D-A)))
    using *
    by (simp, rule_tac x="Re (4/(A-D))" in exI, auto, simp_all add: **)
qed

lemma chordal_circle':
  assumes "B  0" and "(A, B, C, D)  hermitean_nonzero" and "Re (mat_det (A, B, C, D))  0" and
  "C * a2  + (D - A) * a - B = 0" and "r = sqrt((4 - Re((-4 * a/B) * A)) / (1 + Re (a*cnj a)))"
  shows "mk_circline A B C D = chordal_circle (of_complex a) r"
using assms
proof (transfer, transfer)
  fix A B C D a :: complex and r :: real

  let ?k = "(-4) * a / B"

  assume *: "(A, B, C, D)  {H. hermitean H  H  mat_zero}" and **: "B  0" "C * a2 + (D - A) * a - B = 0" and rr: "r = sqrt ((4 - Re (?k * A)) / (1 + Re (a * cnj a)))" and det: "Re (mat_det (A, B, C, D))  0"

  have "is_real A" "is_real D" "C = cnj B"
    using * hermitean_elems
    by auto

  from ** have a12: "let dsc = sqrt(Re ((D-A)2 + 4 * (B*cnj B)))
                      in a = (A - D + cor dsc) / (2 * C)  a = (A - D - cor dsc) / (2 * C)"
  proof-
    have "Re ((D-A)2 + 4 * (B*cnj B))  0"
      using ‹is_real A ‹is_real D
      by (subst complex_mult_cnj_cmod) (simp add: power2_eq_square)
    hence "ccsqrt ((D - A)2 - 4 * C * - B) = cor (sqrt (Re ((D - A)2 + 4 * (B * cnj B))))"
      using csqrt_real[of "((D - A)2 + 4 * (B * cnj B))"] ‹is_real A ‹is_real D C = cnj B
      by (auto simp add: power2_eq_square field_simps)
    thus ?thesis
      using complex_quadratic_equation_two_roots[of C a "D - A" "-B"]
      using  C * a2 + (D - A) * a - B = 0 B  0 C = cnj B
      by (simp add: Let_def)
  qed

  have "is_real ?k"
    using a12 C = cnj B ‹is_real A ‹is_real D
    by (auto simp add: Let_def)
  have "a  0"
    using **
    by auto
  hence "Re ?k  0"
    using ‹is_real (-4*a / B) B  0
    by (metis complex.expand divide_eq_0_iff divisors_zero zero_complex.simps(1) zero_complex.simps(2) zero_neq_neg_numeral)
  moreover
  have "(-4) * a = cor (Re ?k) * B"
    using complex_of_real_Re[OF ‹is_real (-4*a/B)] B  0
    by simp
  moreover
  have "is_real (a/B)"
    using ‹is_real ?k is_real_mult_real[of "-4" "a / B"]
    by simp
  hence "is_real (B * cnj a)"
    using * C = cnj B
    by (metis (no_types, lifting) Im_complex_div_eq_0 complex_cnj_divide eq_cnj_iff_real hermitean_elems(3) mem_Collect_eq mult.commute)
  hence "B * cnj a = cnj B * a"
    using eq_cnj_iff_real[of "B * cnj a"]
    by simp
  hence "-4 * cnj a = cor (Re ?k) * C"
    using C = cnj B
    using complex_of_real_Re[OF ‹is_real ?k] B  0
    by (simp, simp add: field_simps)
  moreover
  have "1 + a * cnj a  0"
    by (simp add: complex_mult_cnj_cmod)
  have "r2 = (4 - Re (?k * A)) / (1 + Re (a * cnj a))"
  proof-
    have "Re (a / B * A)  -1"
      using a12 chordal_circle_radius_positive[of A B C D] * B  0 det
      by (auto simp add: Let_def field_simps)
    from mult_right_mono_neg[OF this, of "-4"]
    have "4 - Re (?k * A)  0"
      using Re_mult_real[of "-4" "a / B * A"]
      by (simp add: field_simps)
    moreover
    have "1 + Re (a * cnj a) > 0"
      using a  0 complex_mult_cnj complex_neq_0
      by auto
    ultimately
    have "(4 - Re (?k * A)) / (1 + Re (a * cnj a))  0"
      by (metis divide_nonneg_pos)
    thus ?thesis
      using rr
      by simp
  qed
  hence "r2 = Re ((4 - ?k * A) / (1 + a * cnj a))"
    using ‹is_real ?k ‹is_real A 1 + a * cnj a  0
    by (subst Re_divide_real, auto)
  hence "(cor r)2 =  (4 - ?k * A) / (1 + a * cnj a)"
    using ‹is_real ?k ‹is_real A mult_reals[of ?k A] 
    by (simp add: cor_squared)
  hence "4 - (cor r)2 * (a * cnj a + 1) = cor (Re ?k) * A"
    using complex_of_real_Re[OF ‹is_real (-4*a/B)]
    using 1 + a * cnj a  0
    by (simp add: field_simps)
  moreover

  have "?k = cnj ?k"
    using ‹is_real ?k
    using eq_cnj_iff_real[of "-4*a/B"]
    by simp

  have "?k2 = cor ((cmod ?k)2)"
    using  cor_cmod_real[OF ‹is_real ?k]
    unfolding power2_eq_square by force
  hence "?k2 = ?k * cnj ?k"
    using complex_mult_cnj_cmod[of ?k]
    by simp
  hence ***: "a * cnj a = (cor ((Re ?k)2) * B * C) / 16"
    using complex_of_real_Re[OF ‹is_real (-4*a/B)] C = cnj B ‹is_real (-4*a/B) B  0
    by simp
  from ** have "cor ((Re ?k)2) * B * C - 4 * cor (Re ?k) * (D-A) - 16 = 0"
    using complex_of_real_Re[OF ‹is_real ?k]
    by (simp add: power2_eq_square, simp add: field_simps, algebra)
  hence "?k * (D-A) = 4 * (cor ((Re ?k)2) * B * C / 16 - 1)"
    by (subst (asm) complex_of_real_Re[OF ‹is_real ?k]) algebra
  hence "?k * (D-A) = 4 * (a*cnj a - 1)"
    by (subst (asm)  ***[symmetric]) simp

  hence "4 * a * cnj a - (cor r)2 * (a * cnj a + 1) = cor (Re ?k) * D"
    using 4 - (cor r)2 * (a * cnj a + 1) = cor (Re ?k) * A
    using complex_of_real_Re[OF ‹is_real (-4*a/B)]
    by simp algebra
  ultimately
  show "circline_eq_cmat (mk_circline_cmat A B C D) (chordal_circle_cvec_cmat (of_complex_cvec a) r)"
    using * a  0
    by (simp, rule_tac x="Re (-4*a / B)" in exI, simp)
qed

end